|
|
@@ -395,415 +395,415 @@ Listing:
|
|
|
376 INC(nSpans)
|
|
|
377 END NoteSpan;
|
|
|
378
|
|
|
- 379 PROCEDURE ProbeBody (pn: SymTab.Name);
|
|
|
- 380 (* Shadow-skip a body: consume tokens counting block openers until the
|
|
|
- 381 matching END, check the name, record the span, verify SeekTo
|
|
|
- 382 repositions exactly, then restore the exact scanner/parser state.
|
|
|
- 383 Superseded by DeferSkip for deferred bodies; kept for the plain
|
|
|
- 384 probe of non-deferred Bodies (methods). *)
|
|
|
- 385 VAR savedSym, savedErr, depth, guard: CARDINAL;
|
|
|
- 386 nm: SymTab.Name;
|
|
|
- 387 ok, sok: BOOLEAN;
|
|
|
- 388 start: M2S.INT32;
|
|
|
- 389 BEGIN
|
|
|
- 390 savedSym := sym; savedErr := errDist; start := M2S.nextPos;
|
|
|
- 391 M2S.PushPos;
|
|
|
- 392 depth := 0; guard := 0; ok := TRUE;
|
|
|
- 393 LOOP
|
|
|
- 394 IF sym = 0 THEN ok := FALSE; EXIT END;
|
|
|
- 395 IF TokIs("END") THEN
|
|
|
- 396 IF depth = 0 THEN EXIT END;
|
|
|
- 397 DEC(depth)
|
|
|
- 398 ELSIF TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
|
|
|
- 399 OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
|
|
|
- 400 OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
|
|
|
- 401 OR TokIs("WITH") THEN
|
|
|
- 402 INC(depth)
|
|
|
- 403 END;
|
|
|
- 404 Adv;
|
|
|
- 405 INC(guard);
|
|
|
- 406 IF guard > 1000000 THEN ok := FALSE; EXIT END
|
|
|
- 407 END;
|
|
|
- 408 IF ok THEN
|
|
|
- 409 Adv;
|
|
|
- 410 M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
|
|
|
- 411 IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END
|
|
|
- 412 END;
|
|
|
- 413 IF ok THEN NoteSpan(pn, start) END;
|
|
|
- 414 sok := TRUE;
|
|
|
- 415 IF ok THEN
|
|
|
- 416 M2S.SeekTo(start);
|
|
|
- 417 Adv;
|
|
|
- 418 IF (sym # savedSym) OR (M2S.nextPos # start) THEN sok := FALSE END
|
|
|
- 419 END;
|
|
|
- 420 M2S.PopPos;
|
|
|
- 421 sym := savedSym; errDist := savedErr;
|
|
|
- 422 IF NOT ok THEN
|
|
|
- 423 FileIO.WriteString(FileIO.StdOut, "twophase probe mismatch in ");
|
|
|
- 424 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
- 425 FileIO.WriteLn(FileIO.StdOut)
|
|
|
- 426 ELSIF NOT sok THEN
|
|
|
- 427 FileIO.WriteString(FileIO.StdOut, "twophase seek mismatch in ");
|
|
|
- 428 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
- 429 FileIO.WriteLn(FileIO.StdOut)
|
|
|
- 430 END
|
|
|
- 431 END ProbeBody;
|
|
|
- 432
|
|
|
- 433 PROCEDURE Openers (): BOOLEAN;
|
|
|
- 434 (* TRUE when the current token opens a block that must be closed by an
|
|
|
- 435 END (BEGIN is excluded: a block's BEGIN shares the declaration END;
|
|
|
- 436 REPEAT..UNTIL and EXIT/RETURN need no END). *)
|
|
|
- 437 BEGIN
|
|
|
- 438 RETURN TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
|
|
|
- 439 OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
|
|
|
- 440 OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
|
|
|
- 441 OR TokIs("WITH")
|
|
|
- 442 END Openers;
|
|
|
- 443
|
|
|
- 444 PROCEDURE DeferSkip (pn: SymTab.Name): BOOLEAN;
|
|
|
- 445 (* Phase 1 of the deferral: skip the body starting at the current token
|
|
|
- 446 (the first token after the heading's ';') up to the matching END,
|
|
|
- 447 verify the END's name, and LEAVE the scanner positioned exactly at
|
|
|
- 448 that END (so Block's trailing "END" ident consumes it for real), with
|
|
|
- 449 the span recorded for the re-parse pass. On any inconsistency,
|
|
|
- 450 restore the scanner and return FALSE so the caller parses normally. *)
|
|
|
- 451 VAR depth, guard: CARDINAL;
|
|
|
- 452 nm: SymTab.Name;
|
|
|
- 453 ok: BOOLEAN;
|
|
|
- 454 start, endPos: M2S.INT32;
|
|
|
- 455 BEGIN
|
|
|
- 456 deferredBody := FALSE;
|
|
|
- 457 start := M2S.nextPos;
|
|
|
- 458 M2S.PushPos;
|
|
|
- 459 depth := 0; guard := 0; ok := TRUE;
|
|
|
- 460 LOOP
|
|
|
- 461 IF sym = 0 THEN ok := FALSE; EXIT END;
|
|
|
- 462 IF TokIs("END") THEN
|
|
|
- 463 IF depth = 0 THEN EXIT END;
|
|
|
- 464 DEC(depth)
|
|
|
- 465 ELSIF Openers() THEN
|
|
|
- 466 INC(depth)
|
|
|
- 467 END;
|
|
|
- 468 Adv;
|
|
|
- 469 INC(guard);
|
|
|
- 470 IF guard > 1000000 THEN ok := FALSE; EXIT END
|
|
|
- 471 END;
|
|
|
- 472 IF ok THEN
|
|
|
- 473 (* sym is the matching END; check the name after it, then seek back
|
|
|
- 474 so Block sees END (its "END" ident then consumes it for real). *)
|
|
|
- 475 endPos := M2S.nextPos;
|
|
|
- 476 Adv;
|
|
|
- 477 M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
|
|
|
- 478 IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END;
|
|
|
- 479 IF ok THEN
|
|
|
- 480 M2S.SeekTo(endPos); Adv
|
|
|
- 481 END
|
|
|
- 482 END;
|
|
|
- 483 IF ok THEN
|
|
|
- 484 NoteSpan(pn, start);
|
|
|
- 485 spanTy[nSpans - 1] := Lower.CurScopeProc();
|
|
|
- 486 spanNode[nSpans - 1] := curProcNode;
|
|
|
- 487 deferredBody := TRUE;
|
|
|
- 488 RETURN TRUE
|
|
|
- 489 ELSE
|
|
|
- 490 M2S.PopPos;
|
|
|
- 491 FileIO.WriteString(FileIO.StdOut, "twophase defer mismatch in ");
|
|
|
- 492 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
- 493 FileIO.WriteLn(FileIO.StdOut);
|
|
|
- 494 RETURN FALSE
|
|
|
- 495 END
|
|
|
- 496 END DeferSkip;
|
|
|
- 497
|
|
|
- 498 CHARACTERS
|
|
|
- 499 eol = CHR(13) .
|
|
|
- 500 lf = CHR(10) .
|
|
|
- 501 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
- 502 digit = "0123456789" .
|
|
|
- 503 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
- 504 noQuote1 = ANY - "'" - eol .
|
|
|
- 505 noQuote2 = ANY - '"' - eol .
|
|
|
- 506
|
|
|
- 507 IGNORE CHR(9) .. CHR(13)
|
|
|
- 508
|
|
|
- 509 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
- 510 COMMENTS FROM "//" TO lf
|
|
|
- 511
|
|
|
- 512 TOKENS
|
|
|
- 513 ident = letter { letter | digit | "_" } .
|
|
|
- 514 integer = digit { digit }
|
|
|
- 515 | digit { digit } CONTEXT("..")
|
|
|
- 516 | "0x" hexDigit { hexDigit }
|
|
|
- 517 | "0X" hexDigit { hexDigit } .
|
|
|
- 518 real = digit { digit } "." { digit }
|
|
|
- 519 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
- 520 string = "'" { noQuote1 } "'"
|
|
|
- 521 | '"' { noQuote2 } '"' .
|
|
|
- 522 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
- 523 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
- 524
|
|
|
- 525 PRODUCTIONS
|
|
|
- 526 M2
|
|
|
- 527 = (. twoPhase := TRUE; astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; astImp := AST.NoNode; astImpTail := AST.NoNode;
|
|
|
- 528 astImp := AST.NoNode;
|
|
|
- 529 astImpTail := AST.NoNode;
|
|
|
- 530 procNest := 0; nSpans := 0;
|
|
|
- 531 SymTab.DeferReset; .)
|
|
|
- 532 Unit "." .
|
|
|
- 533 (* Units: program modules compile fully; DEFINITION and
|
|
|
- 534 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
- 535 (each ends with one 230); same for nested local modules. *)
|
|
|
- 536 (* Generics (Increment 1): formal and actual parameters. Formals are
|
|
|
- 537 TYPE parameters only; actuals are type identifiers. *)
|
|
|
- 538 GenericFormals
|
|
|
- 539 = "(" GenericFormal { ";" GenericFormal } ")" .
|
|
|
- 540 GenericFormal (. VAR nm: SymTab.Name; .)
|
|
|
- 541 = GetIdent<nm> (. IF instActive THEN
|
|
|
- 542 IF NOT SymTab.EnterTypeParamBound(nm,
|
|
|
- 543 InstActualGet(instFk)) THEN
|
|
|
- 544 SemError(200) END
|
|
|
- 545 ELSIF NOT SymTab.EnterTypeParam(nm) THEN
|
|
|
- 546 SemError(200) END;
|
|
|
- 547 INC(instFk); .)
|
|
|
- 548 { "," GetIdent<nm> (. IF instActive THEN
|
|
|
- 549 IF NOT SymTab.EnterTypeParamBound(nm,
|
|
|
- 550 InstActualGet(instFk)) THEN
|
|
|
- 551 SemError(200) END
|
|
|
- 552 ELSIF NOT SymTab.EnterTypeParam(nm) THEN
|
|
|
- 553 SemError(200) END;
|
|
|
- 554 INC(instFk); .) }
|
|
|
- 555 ":" "TYPE" .
|
|
|
- 556 Actuals
|
|
|
- 557 = Actual { "," Actual } .
|
|
|
- 558 Actual (. VAR at: SymTab.TypeIndex; .)
|
|
|
- 559 = TypeIdent<at> (. IF refN <= HIGH(refActual) THEN
|
|
|
- 560 refActual[refN] := at; INC(refN)
|
|
|
- 561 END; .) .
|
|
|
- 562 Unit
|
|
|
- 563 = (. isGen := FALSE;
|
|
|
- 564 allowDefer := FALSE;
|
|
|
- 565 repassing := FALSE; .)
|
|
|
- 566 [ "GENERIC" (. isGen := TRUE; .) ]
|
|
|
- 567 ( DefUnit | ImplUnit | ProgModule ) .
|
|
|
- 568 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
- 569 and one program (last) into one image. Units share the symbol
|
|
|
- 570 table; imports materialize exported names. *)
|
|
|
- 571 DefUnit (. VAR m1, m2, pn: SymTab.Name;
|
|
|
- 572 g: SymTab.Name;
|
|
|
- 573 astSeq, astTail, astProc: AST.Node; .)
|
|
|
- 574 = (. refN := 0; refSeen := FALSE; .)
|
|
|
- 575 "DEFINITION" "MODULE"
|
|
|
- 576 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
- 577 IF instActive THEN
|
|
|
- 578 IF NOT SymTab.Reenter(m1,
|
|
|
- 579 SymTab.UnitDef) THEN
|
|
|
- 580 SemError(200) END
|
|
|
- 581 ELSIF NOT SymTab.BeginDef(m1) THEN
|
|
|
- 582 SemError(200) END;
|
|
|
- 583 QbeGen.SetModule(m1);
|
|
|
- 584 CopyNm(m1, unitName);
|
|
|
- 585 unitWasGen := isGen
|
|
|
- 586 AND NOT instActive;
|
|
|
- 587 unitWasDef := TRUE; .)
|
|
|
- 588 [ GenericFormals ]
|
|
|
- 589 ( ";"
|
|
|
- 590 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 591 astImp, astImpTail, astDecl); .) }
|
|
|
- 592 [ "EXPORT" [ "QUALIFIED" ] (. (* definition-module export
|
|
|
- 593 list: parsed, and the
|
|
|
- 594 names are already exported
|
|
|
- 595 by the module scope *) .)
|
|
|
- 596 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
- 597 (. astSeq := AST.NoNode;
|
|
|
- 598 astTail := AST.NoNode; .)
|
|
|
- 599 { ConstBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
- 600 astSeq, astTail, astDecl); .)
|
|
|
- 601 | TypeBlock<TRUE> (. AstAppend(AST.NkDeclSeq,
|
|
|
- 602 astSeq, astTail, astDecl); .)
|
|
|
- 603 | VarBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
- 604 astSeq, astTail, astDecl); .)
|
|
|
- 605 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 606 (. (* a heading only: record it so
|
|
|
- 607 Lower can replay it *)
|
|
|
- 608 astProc := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 609 AST.SetOp(astProc, 0);
|
|
|
- 610 AST.SetChild(astProc, 0,
|
|
|
- 611 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 612 AstAppend(AST.NkDeclSeq,
|
|
|
- 613 astSeq, astTail, astProc);
|
|
|
- 614 Lower.NoteProcNode(astProc);
|
|
|
- 615 Lower.ScopeLeave;
|
|
|
- 616 SymTab.CloseProc;
|
|
|
- 617 QbeGen.AbortFunc; .) }
|
|
|
- 618 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
- 619 AST.SetChild(astUnit, 0,
|
|
|
- 620 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 621 AST.SetChild(astUnit, 1, astSeq);
|
|
|
- 622 AST.SetChild(astUnit, 3, astImp);
|
|
|
- 623 astDecl := AST.NoNode;
|
|
|
- 624 astStmt := AST.NoNode; .)
|
|
|
- 625 "END"
|
|
|
- 626 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 627 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 628 SemError(202) END;
|
|
|
- 629 SymTab.EndUnit; .)
|
|
|
- 630 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
- 631 (. CopyNm(m1, refInst);
|
|
|
- 632 CopyNm(g, refGen);
|
|
|
- 633 refSeen := TRUE; refIsDef := TRUE;
|
|
|
- 634 astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
- 635 AST.SetChild(astUnit, 0,
|
|
|
- 636 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 637 astDecl := AST.NoNode;
|
|
|
- 638 astStmt := AST.NoNode; .)
|
|
|
- 639 "END"
|
|
|
- 640 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 641 SemError(202) END;
|
|
|
- 642 SymTab.EndUnit; .) ) .
|
|
|
- 643 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
- 644 g: SymTab.Name;
|
|
|
- 645 k: CARDINAL;
|
|
|
- 646 rp: CARDINAL;
|
|
|
- 647 rpOk: BOOLEAN;
|
|
|
- 648 rErrs: INTEGER;
|
|
|
- 649 rDecl, rStmt: AST.Node;
|
|
|
- 650 rnm: SymTab.Name;
|
|
|
- 651 rSym, rErr: CARDINAL;
|
|
|
- 652 fname: SymTab.Name;
|
|
|
- 653 unres: BOOLEAN;
|
|
|
- 654 astNode: AST.Node; .)
|
|
|
- 655 = (. refN := 0; refSeen := FALSE; .)
|
|
|
- 656 "IMPLEMENTATION" "MODULE"
|
|
|
- 657 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
- 658 IF instActive THEN
|
|
|
- 659 IF NOT SymTab.Reenter(m1,
|
|
|
- 660 SymTab.UnitImpl) THEN
|
|
|
- 661 SemError(201) END
|
|
|
- 662 ELSIF NOT SymTab.BeginImpl(m1) THEN
|
|
|
- 663 SemError(201) END;
|
|
|
- 664 astStmt := AST.NoNode;
|
|
|
- 665 astDecl := AST.NoNode;
|
|
|
- 666 astImp := AST.NoNode;
|
|
|
- 667 astImpTail := AST.NoNode;
|
|
|
- 668 nPendVar := 0;
|
|
|
- 669 CopyNm(m1, unitName);
|
|
|
- 670 unitWasGen := isGen AND NOT instActive;
|
|
|
- 671 unitWasDef := FALSE;
|
|
|
- 672 QbeGen.SetModule(m1); .)
|
|
|
- 673 [ GenericFormals ]
|
|
|
- 674 ( ";"
|
|
|
- 675 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 676 astImp, astImpTail, astDecl); .) }
|
|
|
- 677 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 678 [ "BEGIN" (. FlushPend;
|
|
|
- 679 k := 0;
|
|
|
- 680 WHILE k < SymTab.FwdPending() DO
|
|
|
- 681 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 682 IF unres THEN SemError(201) END;
|
|
|
- 683 INC(k)
|
|
|
- 684 END;
|
|
|
- 685 SymTab.FwdClear;
|
|
|
- 686
|
|
|
- 687 nLab := 0; nGot := 0; .)
|
|
|
- 688 [ StatSeq ] ]
|
|
|
- 689 (. IF twoPhaseParse THEN
|
|
|
- 690 rSym := sym; rErr := errDist;
|
|
|
- 691 rDecl := astDecl; rStmt := astStmt;
|
|
|
- 692 M2S.PushPos;
|
|
|
- 693 repassing := TRUE;
|
|
|
- 694 rp := 0;
|
|
|
- 695 WHILE rp < nSpans DO
|
|
|
- 696 k := 0;
|
|
|
- 697 WHILE (k <= HIGH(rnm))
|
|
|
- 698 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
- 699 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
- 700 END;
|
|
|
- 701 rnm[k] := CHR(0);
|
|
|
- 702 M2S.SeekTo(spanStart[rp]);
|
|
|
- 703 Adv;
|
|
|
- 704 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
- 705 IF NOT rpOk THEN
|
|
|
- 706 FileIO.WriteString(FileIO.StdOut,
|
|
|
- 707 "twophase reenter failed");
|
|
|
- 708 FileIO.WriteLn(FileIO.StdOut)
|
|
|
- 709 END;
|
|
|
- 710 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
- 711 QbeGen.BeginFunc("");
|
|
|
- 712 Block(rnm);
|
|
|
- 713 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
- 714 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
- 715 Lower.ScopeLeave;
|
|
|
- 716 SymTab.CloseProc;
|
|
|
- 717 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
- 718 INC(rp)
|
|
|
- 719 END;
|
|
|
- 720 rErrs := M2S.errors;
|
|
|
- 721 repassing := FALSE;
|
|
|
- 722 M2S.PopPos;
|
|
|
- 723 sym := rSym; errDist := rErr;
|
|
|
- 724 M2S.errors := rErrs;
|
|
|
- 725 astDecl := rDecl; astStmt := rStmt
|
|
|
- 726 END; .)
|
|
|
- 727 "END"
|
|
|
- 728 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 729 FlushPend;
|
|
|
- 730 k := 0;
|
|
|
- 731 WHILE k < SymTab.FwdPending() DO
|
|
|
- 732 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 733 IF unres THEN SemError(201) END;
|
|
|
- 734 INC(k)
|
|
|
- 735 END;
|
|
|
- 736 SymTab.FwdClear;
|
|
|
- 737
|
|
|
- 738 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 739 AST.SetChild(astNode, 0,
|
|
|
- 740 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 741 AST.SetChild(astNode, 1, astDecl);
|
|
|
- 742 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 743 AST.SetChild(astNode, 3, astImp);
|
|
|
- 744 astUnit := astNode;
|
|
|
- 745 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 746 SemError(202) END;
|
|
|
- 747 CheckGotos;
|
|
|
- 748 SymTab.EndUnit; .)
|
|
|
- 749 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
- 750 (. CopyNm(m1, refInst);
|
|
|
- 751 CopyNm(g, refGen);
|
|
|
- 752 refSeen := TRUE; refIsDef := FALSE;
|
|
|
- 753 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 754 AST.SetChild(astNode, 0,
|
|
|
- 755 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 756 astDecl := AST.NoNode;
|
|
|
- 757 astStmt := AST.NoNode; .)
|
|
|
- 758 "END"
|
|
|
- 759 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 760 SemError(202) END;
|
|
|
- 761 SymTab.EndUnit; .) ) .
|
|
|
- 762 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 763 k: CARDINAL;
|
|
|
- 764 rp: CARDINAL;
|
|
|
- 765 rpOk: BOOLEAN;
|
|
|
- 766 rErrs: INTEGER;
|
|
|
- 767 rDecl, rStmt: AST.Node;
|
|
|
- 768 rnm: SymTab.Name;
|
|
|
- 769 rSym, rErr: CARDINAL;
|
|
|
- 770 fname: SymTab.Name;
|
|
|
- 771 unres: BOOLEAN;
|
|
|
- 772 astNode: AST.Node; .)
|
|
|
- 773 = "MODULE"
|
|
|
- 774 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
- 775 SemError(200) END;
|
|
|
- 776 astStmt := AST.NoNode;
|
|
|
- 777 astDecl := AST.NoNode;
|
|
|
- 778 astImp := AST.NoNode;
|
|
|
- 779 astImpTail := AST.NoNode;
|
|
|
- 780 nPendVar := 0;
|
|
|
- 781 QbeGen.SetModule(m1); .)
|
|
|
- 782 [ Priority ]
|
|
|
- 783 ";"
|
|
|
- 784 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 785 astImp, astImpTail, astDecl); .) }
|
|
|
- 786 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 787 [ "BEGIN" (. FlushPend;
|
|
|
+ 379 PROCEDURE Openers (): BOOLEAN;
|
|
|
+ 380 (* TRUE when the current token opens a block that must be closed by an
|
|
|
+ 381 END (BEGIN is excluded: a block's BEGIN shares the declaration END;
|
|
|
+ 382 REPEAT..UNTIL and EXIT/RETURN need no END). *)
|
|
|
+ 383 BEGIN
|
|
|
+ 384 RETURN TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
|
|
|
+ 385 OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
|
|
|
+ 386 OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
|
|
|
+ 387 OR TokIs("WITH")
|
|
|
+ 388 END Openers;
|
|
|
+ 389
|
|
|
+ 390 PROCEDURE DeferSkip (pn: SymTab.Name): BOOLEAN;
|
|
|
+ 391 (* Phase 1 of the deferral: skip the body starting at the current token
|
|
|
+ 392 (the first token after the heading's ';') up to the matching END,
|
|
|
+ 393 verify the END's name, and LEAVE the scanner positioned exactly at
|
|
|
+ 394 that END (so Block's trailing "END" ident consumes it for real), with
|
|
|
+ 395 the span recorded for the re-parse pass. On any inconsistency,
|
|
|
+ 396 restore the scanner and return FALSE so the caller parses normally. *)
|
|
|
+ 397 VAR depth, guard: CARDINAL;
|
|
|
+ 398 nm: SymTab.Name;
|
|
|
+ 399 ok: BOOLEAN;
|
|
|
+ 400 start, endPos: M2S.INT32;
|
|
|
+ 401 BEGIN
|
|
|
+ 402 deferredBody := FALSE;
|
|
|
+ 403 start := M2S.nextPos;
|
|
|
+ 404 M2S.PushPos;
|
|
|
+ 405 depth := 0; guard := 0; ok := TRUE;
|
|
|
+ 406 LOOP
|
|
|
+ 407 IF sym = 0 THEN ok := FALSE; EXIT END;
|
|
|
+ 408 IF TokIs("END") THEN
|
|
|
+ 409 IF depth = 0 THEN EXIT END;
|
|
|
+ 410 DEC(depth)
|
|
|
+ 411 ELSIF Openers() THEN
|
|
|
+ 412 INC(depth)
|
|
|
+ 413 END;
|
|
|
+ 414 Adv;
|
|
|
+ 415 INC(guard);
|
|
|
+ 416 IF guard > 1000000 THEN ok := FALSE; EXIT END
|
|
|
+ 417 END;
|
|
|
+ 418 IF ok THEN
|
|
|
+ 419 (* sym is the matching END; check the name after it, then seek back
|
|
|
+ 420 so Block sees END (its "END" ident then consumes it for real). *)
|
|
|
+ 421 endPos := M2S.nextPos;
|
|
|
+ 422 Adv;
|
|
|
+ 423 M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
|
|
|
+ 424 IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END;
|
|
|
+ 425 IF ok THEN
|
|
|
+ 426 M2S.SeekTo(endPos); Adv
|
|
|
+ 427 END
|
|
|
+ 428 END;
|
|
|
+ 429 IF ok THEN
|
|
|
+ 430 NoteSpan(pn, start);
|
|
|
+ 431 spanTy[nSpans - 1] := Lower.CurScopeProc();
|
|
|
+ 432 spanNode[nSpans - 1] := curProcNode;
|
|
|
+ 433 M2S.DropPos; (* keep the scanner at END; discard the snapshot *)
|
|
|
+ 434 deferredBody := TRUE;
|
|
|
+ 435 RETURN TRUE
|
|
|
+ 436 ELSE
|
|
|
+ 437 M2S.PopPos;
|
|
|
+ 438 FileIO.WriteString(FileIO.StdOut, "twophase defer mismatch in ");
|
|
|
+ 439 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
+ 440 FileIO.WriteLn(FileIO.StdOut);
|
|
|
+ 441 RETURN FALSE
|
|
|
+ 442 END
|
|
|
+ 443 END DeferSkip;
|
|
|
+ 444
|
|
|
+ 445 CHARACTERS
|
|
|
+ 446 eol = CHR(13) .
|
|
|
+ 447 lf = CHR(10) .
|
|
|
+ 448 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
+ 449 digit = "0123456789" .
|
|
|
+ 450 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
+ 451 noQuote1 = ANY - "'" - eol .
|
|
|
+ 452 noQuote2 = ANY - '"' - eol .
|
|
|
+ 453
|
|
|
+ 454 IGNORE CHR(9) .. CHR(13)
|
|
|
+ 455
|
|
|
+ 456 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
+ 457 COMMENTS FROM "//" TO lf
|
|
|
+ 458
|
|
|
+ 459 TOKENS
|
|
|
+ 460 ident = letter { letter | digit | "_" } .
|
|
|
+ 461 integer = digit { digit }
|
|
|
+ 462 | digit { digit } CONTEXT("..")
|
|
|
+ 463 | "0x" hexDigit { hexDigit }
|
|
|
+ 464 | "0X" hexDigit { hexDigit } .
|
|
|
+ 465 real = digit { digit } "." { digit }
|
|
|
+ 466 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
+ 467 string = "'" { noQuote1 } "'"
|
|
|
+ 468 | '"' { noQuote2 } '"' .
|
|
|
+ 469 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
+ 470 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
+ 471
|
|
|
+ 472 PRODUCTIONS
|
|
|
+ 473 M2
|
|
|
+ 474 = (. twoPhase := TRUE; astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; astImp := AST.NoNode; astImpTail := AST.NoNode;
|
|
|
+ 475 astImp := AST.NoNode;
|
|
|
+ 476 astImpTail := AST.NoNode;
|
|
|
+ 477 procNest := 0; nSpans := 0;
|
|
|
+ 478 SymTab.DeferReset; .)
|
|
|
+ 479 Unit "." .
|
|
|
+ 480 (* Units: program modules compile fully; DEFINITION and
|
|
|
+ 481 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
+ 482 (each ends with one 230); same for nested local modules. *)
|
|
|
+ 483 (* Generics (Increment 1): formal and actual parameters. Formals are
|
|
|
+ 484 TYPE parameters only; actuals are type identifiers. *)
|
|
|
+ 485 GenericFormals
|
|
|
+ 486 = "(" GenericFormal { ";" GenericFormal } ")" .
|
|
|
+ 487 GenericFormal (. VAR nm: SymTab.Name; .)
|
|
|
+ 488 = GetIdent<nm> (. IF instActive THEN
|
|
|
+ 489 IF NOT SymTab.EnterTypeParamBound(nm,
|
|
|
+ 490 InstActualGet(instFk)) THEN
|
|
|
+ 491 SemError(200) END
|
|
|
+ 492 ELSIF NOT SymTab.EnterTypeParam(nm) THEN
|
|
|
+ 493 SemError(200) END;
|
|
|
+ 494 INC(instFk); .)
|
|
|
+ 495 { "," GetIdent<nm> (. IF instActive THEN
|
|
|
+ 496 IF NOT SymTab.EnterTypeParamBound(nm,
|
|
|
+ 497 InstActualGet(instFk)) THEN
|
|
|
+ 498 SemError(200) END
|
|
|
+ 499 ELSIF NOT SymTab.EnterTypeParam(nm) THEN
|
|
|
+ 500 SemError(200) END;
|
|
|
+ 501 INC(instFk); .) }
|
|
|
+ 502 ":" "TYPE" .
|
|
|
+ 503 Actuals
|
|
|
+ 504 = Actual { "," Actual } .
|
|
|
+ 505 Actual (. VAR at: SymTab.TypeIndex; .)
|
|
|
+ 506 = TypeIdent<at> (. IF refN <= HIGH(refActual) THEN
|
|
|
+ 507 refActual[refN] := at; INC(refN)
|
|
|
+ 508 END; .) .
|
|
|
+ 509 Unit
|
|
|
+ 510 = (. isGen := FALSE;
|
|
|
+ 511 allowDefer := FALSE;
|
|
|
+ 512 repassing := FALSE; .)
|
|
|
+ 513 [ "GENERIC" (. isGen := TRUE; .) ]
|
|
|
+ 514 ( DefUnit | ImplUnit | ProgModule ) .
|
|
|
+ 515 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
+ 516 and one program (last) into one image. Units share the symbol
|
|
|
+ 517 table; imports materialize exported names. *)
|
|
|
+ 518 DefUnit (. VAR m1, m2, pn: SymTab.Name;
|
|
|
+ 519 g: SymTab.Name;
|
|
|
+ 520 astSeq, astTail, astProc: AST.Node; .)
|
|
|
+ 521 = (. refN := 0; refSeen := FALSE; .)
|
|
|
+ 522 "DEFINITION" "MODULE"
|
|
|
+ 523 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
+ 524 IF instActive THEN
|
|
|
+ 525 IF NOT SymTab.Reenter(m1,
|
|
|
+ 526 SymTab.UnitDef) THEN
|
|
|
+ 527 SemError(200) END
|
|
|
+ 528 ELSIF NOT SymTab.BeginDef(m1) THEN
|
|
|
+ 529 SemError(200) END;
|
|
|
+ 530 QbeGen.SetModule(m1);
|
|
|
+ 531 CopyNm(m1, unitName);
|
|
|
+ 532 unitWasGen := isGen
|
|
|
+ 533 AND NOT instActive;
|
|
|
+ 534 unitWasDef := TRUE; .)
|
|
|
+ 535 [ GenericFormals ]
|
|
|
+ 536 ( ";"
|
|
|
+ 537 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 538 astImp, astImpTail, astDecl); .) }
|
|
|
+ 539 [ "EXPORT" [ "QUALIFIED" ] (. (* definition-module export
|
|
|
+ 540 list: parsed, and the
|
|
|
+ 541 names are already exported
|
|
|
+ 542 by the module scope *) .)
|
|
|
+ 543 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
+ 544 (. astSeq := AST.NoNode;
|
|
|
+ 545 astTail := AST.NoNode; .)
|
|
|
+ 546 { ConstBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 547 astSeq, astTail, astDecl); .)
|
|
|
+ 548 | TypeBlock<TRUE> (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 549 astSeq, astTail, astDecl); .)
|
|
|
+ 550 | VarBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 551 astSeq, astTail, astDecl); .)
|
|
|
+ 552 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 553 (. (* a heading only: record it so
|
|
|
+ 554 Lower can replay it *)
|
|
|
+ 555 astProc := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 556 AST.SetOp(astProc, 0);
|
|
|
+ 557 AST.SetChild(astProc, 0,
|
|
|
+ 558 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 559 AstAppend(AST.NkDeclSeq,
|
|
|
+ 560 astSeq, astTail, astProc);
|
|
|
+ 561 Lower.NoteProcNode(astProc);
|
|
|
+ 562 Lower.ScopeLeave;
|
|
|
+ 563 SymTab.CloseProc;
|
|
|
+ 564 QbeGen.AbortFunc; .) }
|
|
|
+ 565 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
+ 566 AST.SetChild(astUnit, 0,
|
|
|
+ 567 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 568 AST.SetChild(astUnit, 1, astSeq);
|
|
|
+ 569 AST.SetChild(astUnit, 3, astImp);
|
|
|
+ 570 astDecl := AST.NoNode;
|
|
|
+ 571 astStmt := AST.NoNode; .)
|
|
|
+ 572 "END"
|
|
|
+ 573 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 574 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 575 SemError(202) END;
|
|
|
+ 576 SymTab.EndUnit; .)
|
|
|
+ 577 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
+ 578 (. CopyNm(m1, refInst);
|
|
|
+ 579 CopyNm(g, refGen);
|
|
|
+ 580 refSeen := TRUE; refIsDef := TRUE;
|
|
|
+ 581 astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
+ 582 AST.SetChild(astUnit, 0,
|
|
|
+ 583 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 584 astDecl := AST.NoNode;
|
|
|
+ 585 astStmt := AST.NoNode; .)
|
|
|
+ 586 "END"
|
|
|
+ 587 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 588 SemError(202) END;
|
|
|
+ 589 SymTab.EndUnit; .) ) .
|
|
|
+ 590 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
+ 591 g: SymTab.Name;
|
|
|
+ 592 k: CARDINAL;
|
|
|
+ 593 rp: CARDINAL;
|
|
|
+ 594 rpOk: BOOLEAN;
|
|
|
+ 595 rErrs: INTEGER;
|
|
|
+ 596 rDecl, rStmt: AST.Node;
|
|
|
+ 597 rnm: SymTab.Name;
|
|
|
+ 598 rSym, rErr: CARDINAL;
|
|
|
+ 599 fname: SymTab.Name;
|
|
|
+ 600 unres: BOOLEAN;
|
|
|
+ 601 astNode: AST.Node; .)
|
|
|
+ 602 = (. refN := 0; refSeen := FALSE; .)
|
|
|
+ 603 "IMPLEMENTATION" "MODULE"
|
|
|
+ 604 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
+ 605 IF instActive THEN
|
|
|
+ 606 IF NOT SymTab.Reenter(m1,
|
|
|
+ 607 SymTab.UnitImpl) THEN
|
|
|
+ 608 SemError(201) END
|
|
|
+ 609 ELSIF NOT SymTab.BeginImpl(m1) THEN
|
|
|
+ 610 SemError(201) END;
|
|
|
+ 611 astStmt := AST.NoNode;
|
|
|
+ 612 astDecl := AST.NoNode;
|
|
|
+ 613 astImp := AST.NoNode;
|
|
|
+ 614 astImpTail := AST.NoNode;
|
|
|
+ 615 nPendVar := 0;
|
|
|
+ 616 CopyNm(m1, unitName);
|
|
|
+ 617 unitWasGen := isGen AND NOT instActive;
|
|
|
+ 618 unitWasDef := FALSE;
|
|
|
+ 619 QbeGen.SetModule(m1); .)
|
|
|
+ 620 [ GenericFormals ]
|
|
|
+ 621 ( ";"
|
|
|
+ 622 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 623 astImp, astImpTail, astDecl); .) }
|
|
|
+ 624 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 625 [ "BEGIN" (. FlushPend;
|
|
|
+ 626 k := 0;
|
|
|
+ 627 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 628 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 629 IF unres THEN SemError(201) END;
|
|
|
+ 630 INC(k)
|
|
|
+ 631 END;
|
|
|
+ 632 SymTab.FwdClear;
|
|
|
+ 633
|
|
|
+ 634 nLab := 0; nGot := 0; .)
|
|
|
+ 635 [ StatSeq ] ]
|
|
|
+ 636 (. IF twoPhaseParse THEN
|
|
|
+ 637 rSym := sym; rErr := errDist;
|
|
|
+ 638 rDecl := astDecl; rStmt := astStmt;
|
|
|
+ 639 M2S.PushPos;
|
|
|
+ 640 repassing := TRUE;
|
|
|
+ 641 rp := 0;
|
|
|
+ 642 WHILE rp < nSpans DO
|
|
|
+ 643 k := 0;
|
|
|
+ 644 WHILE (k <= HIGH(rnm))
|
|
|
+ 645 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
+ 646 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
+ 647 END;
|
|
|
+ 648 rnm[k] := CHR(0);
|
|
|
+ 649 M2S.SeekTo(spanStart[rp]);
|
|
|
+ 650 Adv;
|
|
|
+ 651 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
+ 652 IF NOT rpOk THEN
|
|
|
+ 653 FileIO.WriteString(FileIO.StdOut,
|
|
|
+ 654 "twophase reenter failed");
|
|
|
+ 655 FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ 656 END;
|
|
|
+ 657 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
+ 658 QbeGen.BeginFunc("");
|
|
|
+ 659 Block(rnm);
|
|
|
+ 660 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
+ 661 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
+ 662 Lower.ScopeLeave;
|
|
|
+ 663 SymTab.CloseProc;
|
|
|
+ 664 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
+ 665 INC(rp)
|
|
|
+ 666 END;
|
|
|
+ 667 rErrs := M2S.errors;
|
|
|
+ 668 repassing := FALSE;
|
|
|
+ 669 M2S.PopPos;
|
|
|
+ 670 sym := rSym; errDist := rErr;
|
|
|
+ 671 M2S.errors := rErrs;
|
|
|
+ 672
|
|
|
+ 673 astDecl := rDecl; astStmt := rStmt
|
|
|
+ 674 END; .)
|
|
|
+ 675 "END"
|
|
|
+ 676 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 677 FlushPend;
|
|
|
+ 678 k := 0;
|
|
|
+ 679 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 680 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 681 IF unres THEN SemError(201) END;
|
|
|
+ 682 INC(k)
|
|
|
+ 683 END;
|
|
|
+ 684 SymTab.FwdClear;
|
|
|
+ 685
|
|
|
+ 686 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 687 AST.SetChild(astNode, 0,
|
|
|
+ 688 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 689 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 690 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 691 AST.SetChild(astNode, 3, astImp);
|
|
|
+ 692 astUnit := astNode;
|
|
|
+ 693 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 694 SemError(202) END;
|
|
|
+ 695 CheckGotos;
|
|
|
+ 696 SymTab.EndUnit; .)
|
|
|
+ 697 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
+ 698 (. CopyNm(m1, refInst);
|
|
|
+ 699 CopyNm(g, refGen);
|
|
|
+ 700 refSeen := TRUE; refIsDef := FALSE;
|
|
|
+ 701 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 702 AST.SetChild(astNode, 0,
|
|
|
+ 703 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 704 astDecl := AST.NoNode;
|
|
|
+ 705 astStmt := AST.NoNode; .)
|
|
|
+ 706 "END"
|
|
|
+ 707 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 708 SemError(202) END;
|
|
|
+ 709 SymTab.EndUnit; .) ) .
|
|
|
+ 710 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 711 k: CARDINAL;
|
|
|
+ 712 rp: CARDINAL;
|
|
|
+ 713 rpOk: BOOLEAN;
|
|
|
+ 714 rErrs: INTEGER;
|
|
|
+ 715 rDecl, rStmt: AST.Node;
|
|
|
+ 716 rnm: SymTab.Name;
|
|
|
+ 717 rSym, rErr: CARDINAL;
|
|
|
+ 718 fname: SymTab.Name;
|
|
|
+ 719 unres: BOOLEAN;
|
|
|
+ 720 astNode: AST.Node; .)
|
|
|
+ 721 = "MODULE"
|
|
|
+ 722 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
+ 723 SemError(200) END;
|
|
|
+ 724 astStmt := AST.NoNode;
|
|
|
+ 725 astDecl := AST.NoNode;
|
|
|
+ 726 astImp := AST.NoNode;
|
|
|
+ 727 astImpTail := AST.NoNode;
|
|
|
+ 728 nPendVar := 0;
|
|
|
+ 729 QbeGen.SetModule(m1); .)
|
|
|
+ 730 [ Priority ]
|
|
|
+ 731 ";"
|
|
|
+ 732 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 733 astImp, astImpTail, astDecl); .) }
|
|
|
+ 734 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 735 [ "BEGIN" (. FlushPend;
|
|
|
+ 736 k := 0;
|
|
|
+ 737 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 738 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 739 IF unres THEN SemError(201) END;
|
|
|
+ 740 INC(k)
|
|
|
+ 741 END;
|
|
|
+ 742 SymTab.FwdClear;
|
|
|
+ 743
|
|
|
+ 744 nLab := 0; nGot := 0; .)
|
|
|
+ 745 [ StatSeq ] ]
|
|
|
+ 746 (. IF twoPhaseParse THEN
|
|
|
+ 747 rSym := sym; rErr := errDist;
|
|
|
+ 748 rDecl := astDecl; rStmt := astStmt;
|
|
|
+ 749 M2S.PushPos;
|
|
|
+ 750 repassing := TRUE;
|
|
|
+ 751 rp := 0;
|
|
|
+ 752 WHILE rp < nSpans DO
|
|
|
+ 753 k := 0;
|
|
|
+ 754 WHILE (k <= HIGH(rnm))
|
|
|
+ 755 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
+ 756 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
+ 757 END;
|
|
|
+ 758 rnm[k] := CHR(0);
|
|
|
+ 759 M2S.SeekTo(spanStart[rp]);
|
|
|
+ 760 Adv;
|
|
|
+ 761 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
+ 762 IF NOT rpOk THEN
|
|
|
+ 763 FileIO.WriteString(FileIO.StdOut,
|
|
|
+ 764 "twophase reenter failed");
|
|
|
+ 765 FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ 766 END;
|
|
|
+ 767 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
+ 768 QbeGen.BeginFunc("");
|
|
|
+ 769 Block(rnm);
|
|
|
+ 770 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
+ 771 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
+ 772 Lower.ScopeLeave;
|
|
|
+ 773 SymTab.CloseProc;
|
|
|
+ 774 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
+ 775 INC(rp)
|
|
|
+ 776 END;
|
|
|
+ 777 rErrs := M2S.errors;
|
|
|
+ 778 repassing := FALSE;
|
|
|
+ 779 M2S.PopPos;
|
|
|
+ 780 sym := rSym; errDist := rErr;
|
|
|
+ 781 M2S.errors := rErrs;
|
|
|
+ 782
|
|
|
+ 783 astDecl := rDecl; astStmt := rStmt
|
|
|
+ 784 END; .)
|
|
|
+ 785 "END"
|
|
|
+ 786 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 787 FlushPend;
|
|
|
788 k := 0;
|
|
|
789 WHILE k < SymTab.FwdPending() DO
|
|
|
790 SymTab.FwdInfo(k, fname, unres);
|
|
|
@@ -812,2968 +812,2917 @@ Listing:
|
|
|
793 END;
|
|
|
794 SymTab.FwdClear;
|
|
|
795
|
|
|
- 796 nLab := 0; nGot := 0; .)
|
|
|
- 797 [ StatSeq ] ]
|
|
|
- 798 (. IF twoPhaseParse THEN
|
|
|
- 799 rSym := sym; rErr := errDist;
|
|
|
- 800 rDecl := astDecl; rStmt := astStmt;
|
|
|
- 801 M2S.PushPos;
|
|
|
- 802 repassing := TRUE;
|
|
|
- 803 rp := 0;
|
|
|
- 804 WHILE rp < nSpans DO
|
|
|
- 805 k := 0;
|
|
|
- 806 WHILE (k <= HIGH(rnm))
|
|
|
- 807 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
- 808 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
- 809 END;
|
|
|
- 810 rnm[k] := CHR(0);
|
|
|
- 811 M2S.SeekTo(spanStart[rp]);
|
|
|
- 812 Adv;
|
|
|
- 813 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
- 814 IF NOT rpOk THEN
|
|
|
- 815 FileIO.WriteString(FileIO.StdOut,
|
|
|
- 816 "twophase reenter failed");
|
|
|
- 817 FileIO.WriteLn(FileIO.StdOut)
|
|
|
- 818 END;
|
|
|
- 819 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
- 820 QbeGen.BeginFunc("");
|
|
|
- 821 Block(rnm);
|
|
|
- 822 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
- 823 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
- 824 Lower.ScopeLeave;
|
|
|
- 825 SymTab.CloseProc;
|
|
|
- 826 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
- 827 INC(rp)
|
|
|
- 828 END;
|
|
|
- 829 rErrs := M2S.errors;
|
|
|
- 830 repassing := FALSE;
|
|
|
- 831 M2S.PopPos;
|
|
|
- 832 sym := rSym; errDist := rErr;
|
|
|
- 833 M2S.errors := rErrs;
|
|
|
- 834 astDecl := rDecl; astStmt := rStmt
|
|
|
- 835 END; .)
|
|
|
- 836 "END"
|
|
|
- 837 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 838 FlushPend;
|
|
|
- 839 k := 0;
|
|
|
- 840 WHILE k < SymTab.FwdPending() DO
|
|
|
- 841 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 842 IF unres THEN SemError(201) END;
|
|
|
- 843 INC(k)
|
|
|
- 844 END;
|
|
|
- 845 SymTab.FwdClear;
|
|
|
- 846
|
|
|
- 847 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 848 SemError(202) END;
|
|
|
- 849 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 850 AST.SetChild(astNode, 0,
|
|
|
- 851 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 852 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 796 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 797 SemError(202) END;
|
|
|
+ 798 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 799 AST.SetChild(astNode, 0,
|
|
|
+ 800 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 801 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 802 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 803 AST.SetChild(astNode, 3, astImp);
|
|
|
+ 804 astUnit := astNode;
|
|
|
+ 805 CheckGotos;
|
|
|
+ 806 SymTab.EndUnit; .) .
|
|
|
+ 807 DeclSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 808 = (. astSeq := AST.NoNode;
|
|
|
+ 809 astTail := AST.NoNode; .)
|
|
|
+ 810 { (. astDecl := AST.NoNode; .)
|
|
|
+ 811 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
+ 812 | NestedModule ";" | ClassItem ";" )
|
|
|
+ 813 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 814 astSeq, astTail, astDecl); .) }
|
|
|
+ 815 (. astDecl := astSeq; .) .
|
|
|
+ 816 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
+ 817 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
+ 818 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
+ 819 scope at END. *)
|
|
|
+ 820 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 821 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
+ 822 expCount, k: CARDINAL;
|
|
|
+ 823 astNode, nImp, nImpTail:
|
|
|
+ 824 AST.Node; .)
|
|
|
+ 825 = "MODULE"
|
|
|
+ 826 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
+ 827 SymTab.KindModule) THEN
|
|
|
+ 828 SemError(200) END;
|
|
|
+ 829 SymTab.PushScope;
|
|
|
+ 830 expCount := 0;
|
|
|
+ 831 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 832 AST.SetChild(astNode, 0,
|
|
|
+ 833 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 834 astStmt := AST.NoNode;
|
|
|
+ 835 astDecl := AST.NoNode;
|
|
|
+ 836 nImp := AST.NoNode;
|
|
|
+ 837 nImpTail := AST.NoNode; .)
|
|
|
+ 838 [ Priority ]
|
|
|
+ 839 ";"
|
|
|
+ 840 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 841 nImp, nImpTail, astDecl); .) }
|
|
|
+ 842 [ "EXPORT" [ "QUALIFIED" ]
|
|
|
+ 843 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
+ 844 { "," GetIdent<expNames[expCount]>
|
|
|
+ 845 (. INC(expCount); .) }
|
|
|
+ 846 ";" ]
|
|
|
+ 847 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 848 [ "BEGIN" (. astStmt := AST.NoNode;
|
|
|
+ 849 .)
|
|
|
+ 850 [ StatSeq ] ]
|
|
|
+ 851 "END"
|
|
|
+ 852 GetIdent<m2> (. AST.SetChild(astNode, 1, astDecl);
|
|
|
853 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 854 AST.SetChild(astNode, 3, astImp);
|
|
|
- 855 astUnit := astNode;
|
|
|
- 856 CheckGotos;
|
|
|
- 857 SymTab.EndUnit; .) .
|
|
|
- 858 DeclSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 859 = (. astSeq := AST.NoNode;
|
|
|
- 860 astTail := AST.NoNode; .)
|
|
|
- 861 { (. astDecl := AST.NoNode; .)
|
|
|
- 862 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
- 863 | NestedModule ";" | ClassItem ";" )
|
|
|
- 864 (. AstAppend(AST.NkDeclSeq,
|
|
|
- 865 astSeq, astTail, astDecl); .) }
|
|
|
- 866 (. astDecl := astSeq; .) .
|
|
|
- 867 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
- 868 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
- 869 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
- 870 scope at END. *)
|
|
|
- 871 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 872 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
- 873 expCount, k: CARDINAL;
|
|
|
- 874 astNode, nImp, nImpTail:
|
|
|
- 875 AST.Node; .)
|
|
|
- 876 = "MODULE"
|
|
|
- 877 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
- 878 SymTab.KindModule) THEN
|
|
|
- 879 SemError(200) END;
|
|
|
- 880 SymTab.PushScope;
|
|
|
- 881 expCount := 0;
|
|
|
- 882 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 883 AST.SetChild(astNode, 0,
|
|
|
- 884 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 885 astStmt := AST.NoNode;
|
|
|
- 886 astDecl := AST.NoNode;
|
|
|
- 887 nImp := AST.NoNode;
|
|
|
- 888 nImpTail := AST.NoNode; .)
|
|
|
- 889 [ Priority ]
|
|
|
- 890 ";"
|
|
|
- 891 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 892 nImp, nImpTail, astDecl); .) }
|
|
|
- 893 [ "EXPORT" [ "QUALIFIED" ]
|
|
|
- 894 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
- 895 { "," GetIdent<expNames[expCount]>
|
|
|
- 896 (. INC(expCount); .) }
|
|
|
- 897 ";" ]
|
|
|
- 898 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 899 [ "BEGIN" (. astStmt := AST.NoNode;
|
|
|
- 900 .)
|
|
|
- 901 [ StatSeq ] ]
|
|
|
- 902 "END"
|
|
|
- 903 GetIdent<m2> (. AST.SetChild(astNode, 1, astDecl);
|
|
|
- 904 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 905 AST.SetChild(astNode, 3, nImp);
|
|
|
- 906 astDecl := astNode;
|
|
|
- 907 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 908 SemError(202) END;
|
|
|
- 909 k := 0;
|
|
|
- 910 WHILE k < expCount DO
|
|
|
- 911 SymTab.ExportUp(expNames[k]);
|
|
|
- 912 INC(k)
|
|
|
- 913 END;
|
|
|
- 914 SymTab.PopScope; .) .
|
|
|
- 915 Priority
|
|
|
- 916 = "[" integer "]" (. SemError(230); .) .
|
|
|
- 917 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
- 918 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
- 919 materializes on first use (Design). *)
|
|
|
- 920 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
- 921 import lines don't fail); a known module's missing export is
|
|
|
- 922 201. *)
|
|
|
- 923 Import (. VAR n: SymTab.Name;
|
|
|
- 924 astImport: AST.Node; .)
|
|
|
- 925 = "FROM"
|
|
|
- 926 GetIdent<n> (. astImport := AST.MakeNode(AST.NkImport);
|
|
|
- 927 AST.SetChild(astImport, 0,
|
|
|
- 928 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 929 "IMPORT"
|
|
|
- 930 ImpList<n, astImport> ";" (. astDecl := astImport; .)
|
|
|
- 931 | "IMPORT" (. astImport := AST.MakeNode(AST.NkImport); .)
|
|
|
- 932 ImpModList<astImport> ";" (. astDecl := astImport; .) .
|
|
|
- 933 ImpList<mod: SymTab.Name; node: AST.Node>
|
|
|
- 934 (. VAR n: SymTab.Name; .)
|
|
|
- 935 = ImpName<mod, node>
|
|
|
- 936 { "," ImpName<mod, node> } .
|
|
|
- 937 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
- 938 accepted and ignored: the built-in applies regardless. *)
|
|
|
- 939 ImpName<mod: SymTab.Name; node: AST.Node>
|
|
|
- 940 (. VAR n: SymTab.Name; .)
|
|
|
- 941 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 942 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 943 IF SymTab.Equal(mod, "libc") THEN
|
|
|
- 944 (* intrinsic C library:
|
|
|
- 945 permissive external *)
|
|
|
- 946 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
- 947 SemError(201) END;
|
|
|
- 948 Lower.NoteCProc(n)
|
|
|
- 949 ELSIF SymTab.ModKnown(mod) THEN
|
|
|
- 950 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
- 951 SemError(201)
|
|
|
- 952 ELSE Lower.NoteImportedProc(n)
|
|
|
- 953 END
|
|
|
- 954 END; .)
|
|
|
- 955 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
- 956 | "CHR" | "ORD" | "ORDL" | "VAL" | "ABS" | "CAP"
|
|
|
- 957 | "UCHR" | "CHR8" | "UORD"
|
|
|
- 958 | "INC" | "DEC" ) .
|
|
|
- 959 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
- 960 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 961 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 962 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 963 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
- 964 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
- 965 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
- 966 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
- 967 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
- 968 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
- 969 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 970 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
- 971 astSeq := AST.NoNode;
|
|
|
- 972 astTail := AST.NoNode; .)
|
|
|
- 973 { (. astDecl := AST.NoNode; .)
|
|
|
- 974 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
- 975 (. AstAppend(AST.NkDeclSeq,
|
|
|
- 976 astSeq, astTail, astDecl); .) }
|
|
|
- 977 (. SymTab.EndTypeBlock;
|
|
|
- 978 astDecl := astSeq; .) .
|
|
|
- 979 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
- 980 t, op: SymTab.TypeIndex;
|
|
|
- 981 astNode: AST.Node; .)
|
|
|
- 982 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
- 983 IF op = SymTab.InvalidType THEN
|
|
|
- 984 IF NOT SymTab.Enter(n,
|
|
|
- 985 SymTab.KindType) THEN
|
|
|
- 986 SemError(200) END
|
|
|
- 987 END; .)
|
|
|
- 988 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
- 989 AST.SetChild(astNode, 0,
|
|
|
- 990 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 991 AST.SetTy(astNode, t);
|
|
|
- 992 astDecl := astNode;
|
|
|
- 993 IF op # SymTab.InvalidType THEN
|
|
|
- 994 SymTab.SetTarget(op, t)
|
|
|
- 995 ELSE SymTab.SetSymType(n, t)
|
|
|
- 996 END; .)
|
|
|
- 997 | (. IF op # SymTab.InvalidType THEN
|
|
|
- 998 (* stays opaque *)
|
|
|
- 999 ELSIF NOT isDef THEN
|
|
|
- 1000 SemError(231)
|
|
|
- 1001 ELSE SymTab.SetSymType(n,
|
|
|
- 1002 SymTab.NewAlias()) END; .) ) .
|
|
|
- 1003 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 1004 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
- 1005 | Subrange<t>
|
|
|
- 1006 | Enum<t>
|
|
|
- 1007 | ArrayType<t, allowOpen>
|
|
|
- 1008 | SetType<t>
|
|
|
- 1009 | RecordType<t>
|
|
|
- 1010 | PointerType<t>
|
|
|
- 1011 | ProcType<t> .
|
|
|
- 1012 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
- 1013 = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
|
|
|
- 1014 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
- 1015 are code pointers; params are collected into the descriptor. *)
|
|
|
- 1016 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
- 1017 isV: BOOLEAN; .)
|
|
|
- 1018 = "PROCEDURE" (. res := SymTab.InvalidType;
|
|
|
- 1019 t := SymTab.NewProcType(res); .)
|
|
|
- 1020 [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
|
|
|
- 1021 [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
|
|
|
- 1022 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
- 1023 isV: BOOLEAN;
|
|
|
- 1024 cnt, k: CARDINAL;
|
|
|
- 1025 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
- 1026 = (. isV := FALSE; cnt := 0; .)
|
|
|
- 1027 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1028 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
- 1029 { "," GetIdent<names[cnt]> (. INC(cnt); .) }
|
|
|
- 1030 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
- 1031 WHILE k < cnt DO
|
|
|
- 1032 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 1033 INC(k)
|
|
|
- 1034 END; .)
|
|
|
- 1035 | (. (* type-only parameter list:
|
|
|
- 1036 each name is a type (GNU
|
|
|
- 1037 shorthand used by the
|
|
|
- 1038 Coco/R scanner frame) *)
|
|
|
- 1039 k := 0;
|
|
|
- 1040 WHILE k < cnt DO
|
|
|
- 1041 IF SymTab.Lookup(names[k])
|
|
|
- 1042 AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
|
|
|
- 1043 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
|
|
|
- 1044 pt := SymTab.SymType(names[k])
|
|
|
- 1045 ELSE SemError(201);
|
|
|
- 1046 pt := SymTab.InvalidType
|
|
|
- 1047 END;
|
|
|
- 1048 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 1049 INC(k)
|
|
|
- 1050 END; .) )
|
|
|
- 1051 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
- 1052 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
- 1053 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
- 1054 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
- 1055 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
- 1056 out. Bounds are folded literals (int/char); anything else 230.
|
|
|
- 1057 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
- 1058 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 1059 (. VAR elem: SymTab.TypeIndex;
|
|
|
- 1060 ok: BOOLEAN;
|
|
|
- 1061 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
- 1062 nb, k: CARDINAL;
|
|
|
- 1063 idx: SymTab.TypeIndex;
|
|
|
- 1064 ilo, ihi: INTEGER; .)
|
|
|
- 1065 = "ARRAY"
|
|
|
- 1066 ( "OF" Type<elem, FALSE> (. IF NOT allowOpen THEN
|
|
|
- 1067 SemError(230) END;
|
|
|
- 1068 t := SymTab.NewOpenArray(elem); .)
|
|
|
- 1069 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
- 1070 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
- 1071 type's ordinal bounds give the
|
|
|
- 1072 [lo..hi] pair *)
|
|
|
- 1073 IF SymTab.TypeBounds(idx, ilo,
|
|
|
- 1074 ihi)
|
|
|
- 1075 THEN t := SymTab.NewArrayB(elem,
|
|
|
- 1076 ilo, ihi)
|
|
|
- 1077 ELSE SemError(230);
|
|
|
- 1078 t := SymTab.InvalidType
|
|
|
- 1079 END; .)
|
|
|
- 1080 | "[" (. SymTab.BoundBegin; ok := TRUE; .)
|
|
|
- 1081 BoundPair<ok>
|
|
|
- 1082 { "," BoundPair<ok> }
|
|
|
- 1083 "]" (. (* snapshot before the element
|
|
|
- 1084 type, which reuses the bound
|
|
|
- 1085 buffer for a nested ARRAY *)
|
|
|
- 1086 nb := SymTab.BoundCount();
|
|
|
- 1087 k := 0;
|
|
|
- 1088 WHILE k < nb DO
|
|
|
- 1089 bnds[k] := SymTab.BoundLo(k);
|
|
|
- 1090 bndh[k] := SymTab.BoundHi(k);
|
|
|
- 1091 INC(k)
|
|
|
- 1092 END; .)
|
|
|
- 1093 "OF" Type<elem, FALSE>
|
|
|
- 1094 (. IF ok THEN
|
|
|
- 1095 k := nb;
|
|
|
- 1096 WHILE k > 0 DO
|
|
|
- 1097 DEC(k);
|
|
|
- 1098 elem := SymTab.NewArrayB(
|
|
|
- 1099 elem, bnds[k], bndh[k])
|
|
|
- 1100 END;
|
|
|
- 1101 t := elem
|
|
|
- 1102 ELSE t := SymTab.InvalidType
|
|
|
- 1103 END; .) ) .
|
|
|
- 1104 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 1105 qlo, qhi: QbeGen.QVal;
|
|
|
- 1106 lo, hi: INTEGER;
|
|
|
- 1107 cl, cl2: INTEGER; .)
|
|
|
- 1108 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 1109 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 1110 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 1111 ok := FALSE
|
|
|
- 1112 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
- 1113 cl2 := SymTab.ClassOf(thi);
|
|
|
- 1114 IF ((cl # SymTab.ClInt)
|
|
|
- 1115 AND (cl # SymTab.ClChar))
|
|
|
- 1116 OR ((cl2 # SymTab.ClInt)
|
|
|
- 1117 AND (cl2 # SymTab.ClChar)) THEN
|
|
|
- 1118 SemError(230); ok := FALSE
|
|
|
- 1119 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 1120 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 1121 OR (lo > hi) THEN
|
|
|
- 1122 SemError(230); ok := FALSE
|
|
|
- 1123 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
- 1124 SemError(230); ok := FALSE
|
|
|
- 1125 END;
|
|
|
- 1126 END; .) .
|
|
|
- 1127 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
- 1128 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
- 1129 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
- 1130 comparison across suitable bases are lenient (masks over min
|
|
|
- 1131 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
- 1132 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
- 1133 blo, bhi, bspan: INTEGER;
|
|
|
- 1134 bcls: INTEGER; .)
|
|
|
- 1135 = "SET" "OF" Type<base, FALSE>
|
|
|
- 1136 (. IF base = SymTab.InvalidType THEN
|
|
|
- 1137 t := SymTab.InvalidType
|
|
|
- 1138 ELSE bcls :=
|
|
|
- 1139 SymTab.ClassOf(base);
|
|
|
- 1140 IF bcls = SymTab.ClBool THEN
|
|
|
- 1141 blo := 0; bspan := 2
|
|
|
- 1142 ELSIF bcls = SymTab.ClChar THEN
|
|
|
- 1143 blo := 0; bspan := 256
|
|
|
- 1144 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
- 1145 blo := 0;
|
|
|
- 1146 bspan := VAL(INTEGER,
|
|
|
- 1147 SymTab.EnumCount(base))
|
|
|
- 1148 ELSIF SymTab.SubBounds(base,
|
|
|
- 1149 blo, bhi) THEN
|
|
|
- 1150 bspan := bhi - blo + 1
|
|
|
- 1151 ELSE bspan := 0 END;
|
|
|
- 1152 IF (bspan <= 0)
|
|
|
- 1153 OR (bspan > 65536) THEN
|
|
|
- 1154 SemError(230);
|
|
|
- 1155 t := SymTab.InvalidType
|
|
|
- 1156 ELSE t := SymTab.NewSet(base)
|
|
|
- 1157 END
|
|
|
- 1158 END; .) .
|
|
|
- 1159 (* Records: flat blobs; array fields are pointers to static
|
|
|
- 1160 descriptors (locked amendment), nested records inline. Field
|
|
|
- 1161 offsets static and declaration-ordered. *)
|
|
|
- 1162 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
- 1163 variant part is a `CASE ... END` item; because it starts with the
|
|
|
- 1164 CASE keyword it is unambiguously distinguishable from a field
|
|
|
- 1165 (which starts with an identifier). *)
|
|
|
- 1166 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
- 1167 tagOk: BOOLEAN; .)
|
|
|
- 1168 = "RECORD" (. t := SymTab.NewRecord(); .)
|
|
|
- 1169 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
- 1170 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
- 1171 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
- 1172 = RecField<rec>
|
|
|
- 1173 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
- 1174 (* A variant part: CASE tag : Type OF variants. The layout overlays
|
|
|
- 1175 every branch from the tag slot (see SymTab.ComputeOffsets). *)
|
|
|
- 1176 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
- 1177 tagN: SymTab.Name; .)
|
|
|
- 1178 = "CASE" (. SymTab.ResetFields(rec); .)
|
|
|
- 1179 GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1180 tagN) THEN
|
|
|
- 1181 SemError(200) END; .)
|
|
|
- 1182 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
- 1183 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
- 1184 SemError(224)
|
|
|
- 1185 END;
|
|
|
- 1186 SymTab.FixPendingF(rec, tagT);
|
|
|
- 1187 SymTab.SetVariantTag(rec, tagN); .)
|
|
|
- 1188 "OF"
|
|
|
- 1189 RecFieldList<rec>
|
|
|
- 1190 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
- 1191 RecFieldList<rec> }
|
|
|
- 1192 "END" .
|
|
|
- 1193 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
- 1194 lv1, lv2: QbeGen.QVal; .)
|
|
|
- 1195 = VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] ":"
|
|
|
- 1196 RecField<rec> { ";" [ RecField<rec> ] } .
|
|
|
- 1197 (* Variant case label: a constant (or a constant range). Values are
|
|
|
- 1198 not interpreted (the layout overlays regardless). *)
|
|
|
- 1199 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 1200 (. VAR lname: SymTab.Name; .)
|
|
|
- 1201 = ( ident (. LexName(lname);
|
|
|
- 1202 QbeGen.CopyOp("0", q);
|
|
|
- 1203 t := SymTab.IntType(); .)
|
|
|
- 1204 | integer (. LexString(lname);
|
|
|
- 1205 QbeGen.CopyOp("0", q);
|
|
|
- 1206 t := SymTab.IntType(); .)
|
|
|
- 1207 | charConst (. LexString(lname);
|
|
|
- 1208 QbeGen.CopyOp("0", q);
|
|
|
- 1209 t := SymTab.CharType(); .) ) .
|
|
|
- 1210 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1211 t2: SymTab.TypeIndex; .)
|
|
|
- 1212 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
- 1213 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
- 1214 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1215 n) THEN
|
|
|
- 1216 SemError(200) END; .)
|
|
|
- 1217 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1218 n) THEN
|
|
|
- 1219 SemError(200) END; .) } .
|
|
|
- 1220 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
- 1221 k: INTEGER;
|
|
|
- 1222 dotted: BOOLEAN; .)
|
|
|
- 1223 = GetIdent<n> (. dotted := FALSE;
|
|
|
- 1224 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 1225 k := -1;
|
|
|
- 1226 t := SymTab.ForwardType(n);
|
|
|
- 1227 IF t = SymTab.InvalidType THEN
|
|
|
- 1228 SemError(201)
|
|
|
- 1229 END
|
|
|
- 1230 ELSE k := SymTab.SymKind(n);
|
|
|
- 1231 IF (k = SymTab.KindType)
|
|
|
- 1232 OR (k = SymTab.KindPredef) THEN
|
|
|
- 1233 t := SymTab.SymType(n)
|
|
|
- 1234 ELSE t := SymTab.InvalidType
|
|
|
- 1235 END
|
|
|
- 1236 END; .)
|
|
|
- 1237 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
- 1238 IF k = SymTab.KindModule THEN
|
|
|
- 1239 t := SymTab.QualType(n, qid);
|
|
|
- 1240 IF t = SymTab.InvalidType THEN
|
|
|
- 1241 SemError(201)
|
|
|
- 1242 END
|
|
|
- 1243 ELSE SemError(221);
|
|
|
- 1244 t := SymTab.InvalidType
|
|
|
- 1245 END; .) ]
|
|
|
- 1246 (. IF NOT dotted THEN
|
|
|
- 1247 IF (k = SymTab.KindModule)
|
|
|
- 1248 OR ((k # SymTab.KindType)
|
|
|
- 1249 AND (k # SymTab.KindPredef)
|
|
|
- 1250 AND (k # SymTab.KindImport)
|
|
|
- 1251 AND (k # -1)) THEN
|
|
|
- 1252 SemError(221)
|
|
|
- 1253 END
|
|
|
- 1254 END; .) .
|
|
|
- 1255 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 1256 qlo, qhi: QbeGen.QVal;
|
|
|
- 1257 lo, hi: INTEGER; .)
|
|
|
- 1258 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 1259 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 1260 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 1261 t := SymTab.InvalidType
|
|
|
- 1262 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
- 1263 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
- 1264 SemError(230);
|
|
|
- 1265 t := SymTab.InvalidType
|
|
|
- 1266 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 1267 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 1268 OR (lo > hi) THEN
|
|
|
- 1269 SemError(230);
|
|
|
- 1270 t := SymTab.InvalidType
|
|
|
- 1271 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
- 1272 END; .)
|
|
|
- 1273 "]" .
|
|
|
- 1274 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1275 ord: INTEGER;
|
|
|
- 1276 qv: QbeGen.QVal; .)
|
|
|
- 1277 = "(" (. t := SymTab.NewEnum();
|
|
|
- 1278 ord := 0; .)
|
|
|
- 1279 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1280 SymTab.KindConst) THEN
|
|
|
- 1281 SemError(200) END;
|
|
|
- 1282 SymTab.SetSymType(n, t);
|
|
|
- 1283 QbeGen.IntStr(ord, qv);
|
|
|
- 1284 SymTab.SetSymVal(n, qv);
|
|
|
- 1285 Lower.NoteVar(n,
|
|
|
- 1286 SymTab.KindConst, t);
|
|
|
- 1287 Lower.NoteConstVal(qv);
|
|
|
- 1288 INC(ord); .)
|
|
|
- 1289 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1290 SymTab.KindConst) THEN
|
|
|
- 1291 SemError(200) END;
|
|
|
- 1292 SymTab.SetSymType(n, t);
|
|
|
- 1293 QbeGen.IntStr(ord, qv);
|
|
|
- 1294 SymTab.SetSymVal(n, qv);
|
|
|
- 1295 Lower.NoteVar(n,
|
|
|
- 1296 SymTab.KindConst, t);
|
|
|
- 1297 Lower.NoteConstVal(qv);
|
|
|
- 1298 INC(ord); .) }
|
|
|
- 1299 ")" (. SymTab.SetEnumCount(t,
|
|
|
- 1300 VAL(CARDINAL, ord)); .) .
|
|
|
- 1301 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
- 1302 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
- 1303 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
- 1304 class/impl block. Methods end with ";" per the Table example
|
|
|
- 1305 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
- 1306 (* Single CLASS item in both loops: separating declaration from
|
|
|
- 1307 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
- 1308 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
- 1309 The second token decides after CLASS is consumed. A misplaced
|
|
|
- 1310 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
- 1311 whole unit ends 230 until lowering). *)
|
|
|
- 1312 ClassItem
|
|
|
- 1313 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
- 1314 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
- 1315 ct: SymTab.TypeIndex; .)
|
|
|
- 1316 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
- 1317 SymTab.KindType) THEN
|
|
|
- 1318 SemError(200) END;
|
|
|
- 1319 ct := SymTab.NewClass();
|
|
|
- 1320 SymTab.SetSymType(cn, ct);
|
|
|
- 1321 SymTab.PushClassScope(ct);
|
|
|
- 1322 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1323 AST.SetChild(astCls, 0,
|
|
|
- 1324 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1325 astClsP := AST.NoNode;
|
|
|
- 1326 astClsPTail := AST.NoNode;
|
|
|
- 1327 astClsF := AST.NoNode;
|
|
|
- 1328 astClsFTail := AST.NoNode;
|
|
|
- 1329 astClsM := AST.NoNode;
|
|
|
- 1330 astClsMTail := AST.NoNode; .)
|
|
|
- 1331 [ Parents<ct> ]
|
|
|
- 1332 ";"
|
|
|
- 1333 { ClassField<ct> ";" }
|
|
|
- 1334 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 1335 (. Lower.ScopeLeave;
|
|
|
- 1336 SymTab.CloseProc;
|
|
|
- 1337 QbeGen.AbortFunc; .) }
|
|
|
- 1338 "END"
|
|
|
- 1339 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1340 SemError(202) END;
|
|
|
- 1341 SymTab.LayoutClass(ct);
|
|
|
- 1342 SymTab.PopScope;
|
|
|
- 1343 AST.SetChild(astCls, 1, astClsP);
|
|
|
- 1344 AST.SetChild(astCls, 2, astClsF);
|
|
|
- 1345 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1346 astDecl := astCls; .) .
|
|
|
- 1347 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
- 1348 = "(" Parent1<ct>
|
|
|
- 1349 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
- 1350 ")" .
|
|
|
- 1351 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
- 1352 pt: SymTab.TypeIndex; .)
|
|
|
- 1353 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
- 1354 SemError(201)
|
|
|
- 1355 ELSE pt := SymTab.SymType(p);
|
|
|
- 1356 IF SymTab.ClassOf(pt) #
|
|
|
- 1357 SymTab.ClClass THEN
|
|
|
- 1358 SemError(230)
|
|
|
- 1359 ELSE SymTab.SetParent(ct, pt)
|
|
|
- 1360 END
|
|
|
- 1361 END;
|
|
|
- 1362 AstAppend(AST.NkFieldDecl,
|
|
|
- 1363 astClsP, astClsPTail,
|
|
|
- 1364 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
- 1365 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
- 1366 t: SymTab.TypeIndex;
|
|
|
- 1367 astNode: AST.Node; .)
|
|
|
- 1368 = GetIdent<n>
|
|
|
- 1369 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
- 1370 SymTab.KindConst) THEN
|
|
|
- 1371 SemError(200) END;
|
|
|
- 1372 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1373 AST.SetChild(astNode, 0,
|
|
|
- 1374 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1375 AST.SetChild(astNode, 1,
|
|
|
- 1376 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
- 1377 AstAppend(AST.NkFieldDecl,
|
|
|
- 1378 astClsF, astClsFTail, astNode);
|
|
|
- 1379 IF SymTab.Lookup(rhs) THEN
|
|
|
- 1380 SymTab.SetSymType(n,
|
|
|
- 1381 SymTab.SymType(rhs))
|
|
|
- 1382 END; .)
|
|
|
- 1383 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1384 n) THEN
|
|
|
- 1385 SemError(200) END;
|
|
|
- 1386 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1387 AST.SetChild(astNode, 0,
|
|
|
- 1388 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1389 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1390 n) THEN
|
|
|
- 1391 SemError(200) END;
|
|
|
- 1392 AST.SetChild(astNode,
|
|
|
- 1393 AST.NChild(astNode),
|
|
|
- 1394 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
- 1395 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
- 1396 AST.SetTy(astNode, t);
|
|
|
- 1397 AstAppend(AST.NkFieldDecl,
|
|
|
- 1398 astClsF, astClsFTail, astNode); .) ) .
|
|
|
- 1399 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
- 1400 (. VAR wantVirt: BOOLEAN; .)
|
|
|
- 1401 = (. wantVirt := FALSE; .)
|
|
|
- 1402 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
- 1403 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
- 1404 SymTab.MarkVirtual END;
|
|
|
- 1405 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 1406 AST.SetChild(astMethod, 0,
|
|
|
- 1407 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 1408 IF wantVirt THEN
|
|
|
- 1409 AST.SetOp(astMethod, 3)
|
|
|
- 1410 ELSE AST.SetOp(astMethod, 0)
|
|
|
- 1411 END;
|
|
|
- 1412 AstAppend(AST.NkFieldDecl,
|
|
|
- 1413 astClsM, astClsMTail, astMethod); .) .
|
|
|
- 1414 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
- 1415 ct: SymTab.TypeIndex; .)
|
|
|
- 1416 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
- 1417 SemError(201);
|
|
|
- 1418 ct := SymTab.InvalidType
|
|
|
- 1419 ELSE ct := SymTab.SymType(cn);
|
|
|
- 1420 IF SymTab.ClassOf(ct) #
|
|
|
- 1421 SymTab.ClClass THEN
|
|
|
- 1422 SemError(230);
|
|
|
- 1423 ct := SymTab.InvalidType
|
|
|
- 1424 END
|
|
|
- 1425 END;
|
|
|
- 1426 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1427 AST.SetOp(astCls, 1);
|
|
|
- 1428 AST.SetChild(astCls, 0,
|
|
|
- 1429 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1430 astClsM := AST.NoNode;
|
|
|
- 1431 astClsMTail := AST.NoNode;
|
|
|
- 1432 astStmt := AST.NoNode;
|
|
|
- 1433 IF ct #
|
|
|
- 1434 SymTab.InvalidType THEN
|
|
|
- 1435 IF NOT SymTab.PushClassMembers(
|
|
|
- 1436 ct) THEN
|
|
|
- 1437 SemError(230) END;
|
|
|
- 1438 SymTab.PushImplClass(ct)
|
|
|
- 1439 END; .)
|
|
|
- 1440 ";" { MethodImpl<ct> ";" }
|
|
|
- 1441 (. astStmt := AST.NoNode; .)
|
|
|
- 1442 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
- 1443 .)
|
|
|
- 1444 [ StatSeq ] ]
|
|
|
- 1445 "END"
|
|
|
- 1446 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1447 SemError(202) END;
|
|
|
- 1448 SymTab.PopImplClass;
|
|
|
- 1449 SymTab.PopScope;
|
|
|
- 1450 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
- 1451 AST.SetChild(astCls, 2, astStmt);
|
|
|
- 1452 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1453 astDecl := astCls; .) .
|
|
|
- 1454 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
- 1455 thisQ: QbeGen.QVal;
|
|
|
- 1456 methRes: SymTab.TypeIndex; .)
|
|
|
- 1457 = MethodHeading<pn, ct> ";"
|
|
|
- 1458 (. IF (ct #
|
|
|
- 1459 SymTab.InvalidType)
|
|
|
- 1460 AND NOT SymTab.MethodExists(ct,
|
|
|
- 1461 pn) THEN
|
|
|
- 1462 SemError(201) END; .)
|
|
|
- 1463 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
- 1464 SymTab.MarkFwd;
|
|
|
- 1465 QbeGen.AbortFunc;
|
|
|
- 1466 Lower.ScopeLeave;
|
|
|
- 1467 SymTab.CloseProc; .)
|
|
|
- 1468 | (.
|
|
|
- 1469 (* bind the receiver: bare
|
|
|
- 1470 field names resolve
|
|
|
- 1471 against THIS *)
|
|
|
- 1472 QbeGen.CopyOp("@", thisQ);
|
|
|
- 1473 QbeGen.PushWith(thisQ); .)
|
|
|
- 1474 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
- 1475 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
- 1476 QbeGen.PopWith;
|
|
|
- 1477 methRes := SymTab.CurRes();
|
|
|
- 1478 Lower.ScopeLeave;
|
|
|
- 1479 SymTab.CloseProc;
|
|
|
- 1480 QbeGen.EndFunc(methRes); .) ) .
|
|
|
- 1481 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1482 = "CONST" (. astSeq := AST.NoNode;
|
|
|
- 1483 astTail := AST.NoNode; .)
|
|
|
- 1484 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1485 astSeq, astTail, astDecl); .) }
|
|
|
- 1486 (. astDecl := astSeq; .) .
|
|
|
- 1487 ConstDecl (. VAR n: SymTab.Name;
|
|
|
- 1488 t: SymTab.TypeIndex;
|
|
|
- 1489 qv: QbeGen.QVal;
|
|
|
- 1490 cls: INTEGER;
|
|
|
- 1491 astNode: AST.Node; .)
|
|
|
- 1492 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1493 SymTab.KindConst) THEN
|
|
|
- 1494 SemError(200) END; .)
|
|
|
- 1495 "="
|
|
|
- 1496 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1497 AST.SetChild(astNode, 0,
|
|
|
- 1498 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1499 AST.SetChild(astNode, 1, astCur);
|
|
|
- 1500 AST.SetTy(astNode, t);
|
|
|
- 1501 astDecl := astNode;
|
|
|
- 1502 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
- 1503 Lower.NoteConstVal(qv);
|
|
|
- 1504 SymTab.SetSymType(n, t);
|
|
|
- 1505 cls := SymTab.ClassOf(t);
|
|
|
- 1506 IF (cls = SymTab.ClArray)
|
|
|
- 1507 OR (cls = SymTab.ClRecord)
|
|
|
- 1508 OR (cls = SymTab.ClClass)
|
|
|
- 1509 OR (cls = SymTab.ClStr)
|
|
|
- 1510 OR (cls = SymTab.ClUStr) THEN
|
|
|
- 1511 (* an aggregate/string
|
|
|
- 1512 constant: qv is its
|
|
|
- 1513 descriptor address; no
|
|
|
- 1514 scalar data *)
|
|
|
- 1515 SymTab.SetSymVal(n, qv)
|
|
|
- 1516 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
- 1517 SemError(230)
|
|
|
- 1518 ELSE
|
|
|
- 1519 SymTab.SetSymVal(n, qv);
|
|
|
- 1520 END; .) .
|
|
|
- 1521 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1522 = "VAR" (. astSeq := AST.NoNode;
|
|
|
- 1523 astTail := AST.NoNode; .)
|
|
|
- 1524 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1525 astSeq, astTail, astDecl); .) }
|
|
|
- 1526 (. astDecl := astSeq; .) .
|
|
|
- 1527 VarDecl (. VAR nm: SymTab.Name;
|
|
|
- 1528 t: SymTab.TypeIndex;
|
|
|
- 1529 i: CARDINAL;
|
|
|
- 1530 cls: INTEGER;
|
|
|
- 1531 astNode, astTail: AST.Node; .)
|
|
|
- 1532 = VarIdents ":"
|
|
|
- 1533 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1534 astTail := astNode;
|
|
|
- 1535 i := 0;
|
|
|
- 1536 WHILE i < SymTab.PendCount() DO
|
|
|
- 1537 SymTab.PendName(i, nm);
|
|
|
- 1538 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
- 1539 (* chunked: a VAR list can
|
|
|
- 1540 exceed AST.MaxChild *)
|
|
|
- 1541 AstAppend(AST.NkBlock,
|
|
|
- 1542 astNode, astTail,
|
|
|
- 1543 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
- 1544 INC(i)
|
|
|
- 1545 END;
|
|
|
- 1546 AST.SetTy(astNode, t);
|
|
|
- 1547 astDecl := astNode;
|
|
|
- 1548 cls := SymTab.ClassOf(t);
|
|
|
- 1549 IF (t # SymTab.InvalidType)
|
|
|
- 1550 AND NOT SymTab.IsUnresolved(t)
|
|
|
- 1551 AND (cls # SymTab.ClInt)
|
|
|
- 1552 AND (cls # SymTab.ClBool)
|
|
|
- 1553 AND (cls # SymTab.ClChar)
|
|
|
- 1554 AND (cls # SymTab.ClReal)
|
|
|
- 1555 AND (cls # SymTab.ClArray)
|
|
|
- 1556 AND (cls # SymTab.ClSet)
|
|
|
- 1557 AND (cls # SymTab.ClRecord)
|
|
|
- 1558 AND (cls # SymTab.ClPtr)
|
|
|
- 1559 AND (cls # SymTab.ClLong)
|
|
|
- 1560 AND (cls # SymTab.ClProc)
|
|
|
- 1561 AND (cls # SymTab.ClUChar)
|
|
|
- 1562 AND (cls # SymTab.ClUStr)
|
|
|
- 1563 AND (cls # SymTab.ClEnum)
|
|
|
- 1564 AND (cls # SymTab.ClClass) THEN
|
|
|
- 1565 SemError(230) END;
|
|
|
- 1566 IF QbeGen.LocFull() THEN
|
|
|
- 1567 SemError(233) END;
|
|
|
- 1568 i := 0;
|
|
|
- 1569 IF SymTab.IsUnresolved(t)
|
|
|
- 1570 AND NOT SymTab.InProc() THEN
|
|
|
- 1571 (* a forward-typed global:
|
|
|
- 1572 defer emission until the
|
|
|
- 1573 TYPE block completes *)
|
|
|
- 1574 AST.SetOp(astNode, 1);
|
|
|
- 1575 WHILE i < SymTab.PendCount() DO
|
|
|
- 1576 SymTab.PendName(i, nm);
|
|
|
- 1577 IF nPendVar <=
|
|
|
- 1578 HIGH(pendVarName) THEN
|
|
|
- 1579 pendVarName[nPendVar] := nm;
|
|
|
- 1580 pendVarT[nPendVar] := t;
|
|
|
- 1581 INC(nPendVar)
|
|
|
- 1582 END;
|
|
|
- 1583 INC(i)
|
|
|
- 1584 END
|
|
|
- 1585 ELSE
|
|
|
- 1586 WHILE i < SymTab.PendCount() DO
|
|
|
- 1587 SymTab.PendName(i, nm);
|
|
|
- 1588 INC(i)
|
|
|
- 1589 END
|
|
|
- 1590 END;
|
|
|
- 1591 (* a plain VAR list, not a
|
|
|
- 1592 heading: the signature
|
|
|
- 1593 result is discarded *)
|
|
|
- 1594 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 1595 END; .) .
|
|
|
- 1596 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
- 1597 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 1598 SymTab.KindVar) THEN
|
|
|
- 1599 SemError(200) END; .)
|
|
|
- 1600 { ","
|
|
|
- 1601 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 1602 SymTab.KindVar) THEN
|
|
|
- 1603 SemError(200) END; .) } .
|
|
|
- 1604 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
- 1605 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 1606 SemError(200) END; .)
|
|
|
- 1607 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 1608 SemError(200) END; .) } .
|
|
|
- 1609 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
- 1610 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
- 1611 FORWARD marks; the body heading re-enters (signature compare
|
|
|
- 1612 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
- 1613 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
- 1614 (. VAR t: SymTab.TypeIndex;
|
|
|
- 1615 mg: QbeGen.QVal; .)
|
|
|
- 1616 = "PROCEDURE"
|
|
|
- 1617 GetIdent<pn> (. IF methCls #
|
|
|
- 1618 SymTab.InvalidType THEN
|
|
|
- 1619 (* a method: resume the
|
|
|
- 1620 declared symbol (reuse
|
|
|
- 1621 its uid) *)
|
|
|
- 1622 IF NOT SymTab.ResumeMethod(
|
|
|
- 1623 methCls, pn) THEN
|
|
|
- 1624 SemError(200) END
|
|
|
- 1625 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
- 1626 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
- 1627 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
- 1628 SemError(200) END
|
|
|
- 1629 END
|
|
|
- 1630 END;
|
|
|
- 1631 Lower.ScopeEnter;
|
|
|
- 1632 Lower.NoteProc(pn,
|
|
|
- 1633 SymTab.ProcUid(pn),
|
|
|
- 1634 SymTab.InvalidType,
|
|
|
- 1635 SymTab.ProcDepthOf(pn),
|
|
|
- 1636 FALSE);
|
|
|
- 1637 QbeGen.BeginFunc("");
|
|
|
- 1638 IF methCls #
|
|
|
- 1639 SymTab.InvalidType THEN
|
|
|
- 1640 (* hidden THIS receiver:
|
|
|
- 1641 a VAR param of the
|
|
|
- 1642 class type, pushed as
|
|
|
- 1643 the WITH base *)
|
|
|
- 1644 IF NOT SymTab.EnterThisParam(
|
|
|
- 1645 methCls) THEN
|
|
|
- 1646 SemError(200) END;
|
|
|
- 1647 IF NOT QbeGen.FuncParam(
|
|
|
- 1648 "THIS", TRUE,
|
|
|
- 1649 methCls) THEN
|
|
|
- 1650 SemError(233) END
|
|
|
- 1651 END; .)
|
|
|
- 1652 [ FormalParams ]
|
|
|
- 1653 [ ":" TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
- 1654 SemError(235) END;
|
|
|
- 1655 Lower.SetProcRes(t); .) ] .
|
|
|
- 1656 FormalParams
|
|
|
- 1657 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
- 1658 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
- 1659 nm: SymTab.Name;
|
|
|
- 1660 i: CARDINAL;
|
|
|
- 1661 isV: BOOLEAN; .)
|
|
|
- 1662 = (. isV := FALSE; .)
|
|
|
- 1663 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1664 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
- 1665 WHILE i < SymTab.PendCount() DO
|
|
|
- 1666 SymTab.PendName(i, nm);
|
|
|
- 1667 Lower.NoteParam(nm, t, isV);
|
|
|
- 1668 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
- 1669 (* value open arrays are
|
|
|
- 1670 passed as descriptor
|
|
|
- 1671 addresses (no copy):
|
|
|
- 1672 same representation as
|
|
|
- 1673 VAR formals *)
|
|
|
- 1674 IF NOT QbeGen.FuncParam(nm,
|
|
|
- 1675 isV
|
|
|
- 1676 OR SymTab.IsOpenArray(t),
|
|
|
- 1677 t) THEN
|
|
|
- 1678 SemError(233) END;
|
|
|
- 1679 INC(i)
|
|
|
+ 854 AST.SetChild(astNode, 3, nImp);
|
|
|
+ 855 astDecl := astNode;
|
|
|
+ 856 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 857 SemError(202) END;
|
|
|
+ 858 k := 0;
|
|
|
+ 859 WHILE k < expCount DO
|
|
|
+ 860 SymTab.ExportUp(expNames[k]);
|
|
|
+ 861 INC(k)
|
|
|
+ 862 END;
|
|
|
+ 863 SymTab.PopScope; .) .
|
|
|
+ 864 Priority
|
|
|
+ 865 = "[" integer "]" (. SemError(230); .) .
|
|
|
+ 866 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
+ 867 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
+ 868 materializes on first use (Design). *)
|
|
|
+ 869 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
+ 870 import lines don't fail); a known module's missing export is
|
|
|
+ 871 201. *)
|
|
|
+ 872 Import (. VAR n: SymTab.Name;
|
|
|
+ 873 astImport: AST.Node; .)
|
|
|
+ 874 = "FROM"
|
|
|
+ 875 GetIdent<n> (. astImport := AST.MakeNode(AST.NkImport);
|
|
|
+ 876 AST.SetChild(astImport, 0,
|
|
|
+ 877 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 878 "IMPORT"
|
|
|
+ 879 ImpList<n, astImport> ";" (. astDecl := astImport; .)
|
|
|
+ 880 | "IMPORT" (. astImport := AST.MakeNode(AST.NkImport); .)
|
|
|
+ 881 ImpModList<astImport> ";" (. astDecl := astImport; .) .
|
|
|
+ 882 ImpList<mod: SymTab.Name; node: AST.Node>
|
|
|
+ 883 (. VAR n: SymTab.Name; .)
|
|
|
+ 884 = ImpName<mod, node>
|
|
|
+ 885 { "," ImpName<mod, node> } .
|
|
|
+ 886 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
+ 887 accepted and ignored: the built-in applies regardless. *)
|
|
|
+ 888 ImpName<mod: SymTab.Name; node: AST.Node>
|
|
|
+ 889 (. VAR n: SymTab.Name; .)
|
|
|
+ 890 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 891 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 892 IF SymTab.Equal(mod, "libc") THEN
|
|
|
+ 893 (* intrinsic C library:
|
|
|
+ 894 permissive external *)
|
|
|
+ 895 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
+ 896 SemError(201) END;
|
|
|
+ 897 Lower.NoteCProc(n)
|
|
|
+ 898 ELSIF SymTab.ModKnown(mod) THEN
|
|
|
+ 899 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
+ 900 SemError(201)
|
|
|
+ 901 ELSE Lower.NoteImportedProc(n)
|
|
|
+ 902 END
|
|
|
+ 903 END; .)
|
|
|
+ 904 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
+ 905 | "CHR" | "ORD" | "ORDL" | "VAL" | "ABS" | "CAP"
|
|
|
+ 906 | "UCHR" | "CHR8" | "UORD"
|
|
|
+ 907 | "INC" | "DEC" ) .
|
|
|
+ 908 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
+ 909 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 910 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 911 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 912 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
+ 913 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
+ 914 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
+ 915 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
+ 916 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
+ 917 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
+ 918 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 919 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
+ 920 astSeq := AST.NoNode;
|
|
|
+ 921 astTail := AST.NoNode; .)
|
|
|
+ 922 { (. astDecl := AST.NoNode; .)
|
|
|
+ 923 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
+ 924 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 925 astSeq, astTail, astDecl); .) }
|
|
|
+ 926 (. SymTab.EndTypeBlock;
|
|
|
+ 927 astDecl := astSeq; .) .
|
|
|
+ 928 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
+ 929 t, op: SymTab.TypeIndex;
|
|
|
+ 930 astNode: AST.Node; .)
|
|
|
+ 931 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
+ 932 IF op = SymTab.InvalidType THEN
|
|
|
+ 933 IF NOT SymTab.Enter(n,
|
|
|
+ 934 SymTab.KindType) THEN
|
|
|
+ 935 SemError(200) END
|
|
|
+ 936 END; .)
|
|
|
+ 937 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
+ 938 AST.SetChild(astNode, 0,
|
|
|
+ 939 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 940 AST.SetTy(astNode, t);
|
|
|
+ 941 astDecl := astNode;
|
|
|
+ 942 IF op # SymTab.InvalidType THEN
|
|
|
+ 943 SymTab.SetTarget(op, t)
|
|
|
+ 944 ELSE SymTab.SetSymType(n, t)
|
|
|
+ 945 END; .)
|
|
|
+ 946 | (. IF op # SymTab.InvalidType THEN
|
|
|
+ 947 (* stays opaque *)
|
|
|
+ 948 ELSIF NOT isDef THEN
|
|
|
+ 949 SemError(231)
|
|
|
+ 950 ELSE SymTab.SetSymType(n,
|
|
|
+ 951 SymTab.NewAlias()) END; .) ) .
|
|
|
+ 952 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 953 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
+ 954 | Subrange<t>
|
|
|
+ 955 | Enum<t>
|
|
|
+ 956 | ArrayType<t, allowOpen>
|
|
|
+ 957 | SetType<t>
|
|
|
+ 958 | RecordType<t>
|
|
|
+ 959 | PointerType<t>
|
|
|
+ 960 | ProcType<t> .
|
|
|
+ 961 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
+ 962 = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
|
|
|
+ 963 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
+ 964 are code pointers; params are collected into the descriptor. *)
|
|
|
+ 965 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
+ 966 isV: BOOLEAN; .)
|
|
|
+ 967 = "PROCEDURE" (. res := SymTab.InvalidType;
|
|
|
+ 968 t := SymTab.NewProcType(res); .)
|
|
|
+ 969 [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
|
|
|
+ 970 [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
|
|
|
+ 971 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
+ 972 isV: BOOLEAN;
|
|
|
+ 973 cnt, k: CARDINAL;
|
|
|
+ 974 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
+ 975 = (. isV := FALSE; cnt := 0; .)
|
|
|
+ 976 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 977 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
+ 978 { "," GetIdent<names[cnt]> (. INC(cnt); .) }
|
|
|
+ 979 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
+ 980 WHILE k < cnt DO
|
|
|
+ 981 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 982 INC(k)
|
|
|
+ 983 END; .)
|
|
|
+ 984 | (. (* type-only parameter list:
|
|
|
+ 985 each name is a type (GNU
|
|
|
+ 986 shorthand used by the
|
|
|
+ 987 Coco/R scanner frame) *)
|
|
|
+ 988 k := 0;
|
|
|
+ 989 WHILE k < cnt DO
|
|
|
+ 990 IF SymTab.Lookup(names[k])
|
|
|
+ 991 AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
|
|
|
+ 992 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
|
|
|
+ 993 pt := SymTab.SymType(names[k])
|
|
|
+ 994 ELSE SemError(201);
|
|
|
+ 995 pt := SymTab.InvalidType
|
|
|
+ 996 END;
|
|
|
+ 997 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 998 INC(k)
|
|
|
+ 999 END; .) )
|
|
|
+ 1000 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
+ 1001 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
+ 1002 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
+ 1003 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
+ 1004 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
+ 1005 out. Bounds are folded literals (int/char); anything else 230.
|
|
|
+ 1006 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
+ 1007 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 1008 (. VAR elem: SymTab.TypeIndex;
|
|
|
+ 1009 ok: BOOLEAN;
|
|
|
+ 1010 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
+ 1011 nb, k: CARDINAL;
|
|
|
+ 1012 idx: SymTab.TypeIndex;
|
|
|
+ 1013 ilo, ihi: INTEGER; .)
|
|
|
+ 1014 = "ARRAY"
|
|
|
+ 1015 ( "OF" Type<elem, FALSE> (. IF NOT allowOpen THEN
|
|
|
+ 1016 SemError(230) END;
|
|
|
+ 1017 t := SymTab.NewOpenArray(elem); .)
|
|
|
+ 1018 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
+ 1019 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
+ 1020 type's ordinal bounds give the
|
|
|
+ 1021 [lo..hi] pair *)
|
|
|
+ 1022 IF SymTab.TypeBounds(idx, ilo,
|
|
|
+ 1023 ihi)
|
|
|
+ 1024 THEN t := SymTab.NewArrayB(elem,
|
|
|
+ 1025 ilo, ihi)
|
|
|
+ 1026 ELSE SemError(230);
|
|
|
+ 1027 t := SymTab.InvalidType
|
|
|
+ 1028 END; .)
|
|
|
+ 1029 | "[" (. SymTab.BoundBegin; ok := TRUE; .)
|
|
|
+ 1030 BoundPair<ok>
|
|
|
+ 1031 { "," BoundPair<ok> }
|
|
|
+ 1032 "]" (. (* snapshot before the element
|
|
|
+ 1033 type, which reuses the bound
|
|
|
+ 1034 buffer for a nested ARRAY *)
|
|
|
+ 1035 nb := SymTab.BoundCount();
|
|
|
+ 1036 k := 0;
|
|
|
+ 1037 WHILE k < nb DO
|
|
|
+ 1038 bnds[k] := SymTab.BoundLo(k);
|
|
|
+ 1039 bndh[k] := SymTab.BoundHi(k);
|
|
|
+ 1040 INC(k)
|
|
|
+ 1041 END; .)
|
|
|
+ 1042 "OF" Type<elem, FALSE>
|
|
|
+ 1043 (. IF ok THEN
|
|
|
+ 1044 k := nb;
|
|
|
+ 1045 WHILE k > 0 DO
|
|
|
+ 1046 DEC(k);
|
|
|
+ 1047 elem := SymTab.NewArrayB(
|
|
|
+ 1048 elem, bnds[k], bndh[k])
|
|
|
+ 1049 END;
|
|
|
+ 1050 t := elem
|
|
|
+ 1051 ELSE t := SymTab.InvalidType
|
|
|
+ 1052 END; .) ) .
|
|
|
+ 1053 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 1054 qlo, qhi: QbeGen.QVal;
|
|
|
+ 1055 lo, hi: INTEGER;
|
|
|
+ 1056 cl, cl2: INTEGER; .)
|
|
|
+ 1057 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 1058 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 1059 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 1060 ok := FALSE
|
|
|
+ 1061 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
+ 1062 cl2 := SymTab.ClassOf(thi);
|
|
|
+ 1063 IF ((cl # SymTab.ClInt)
|
|
|
+ 1064 AND (cl # SymTab.ClChar))
|
|
|
+ 1065 OR ((cl2 # SymTab.ClInt)
|
|
|
+ 1066 AND (cl2 # SymTab.ClChar)) THEN
|
|
|
+ 1067 SemError(230); ok := FALSE
|
|
|
+ 1068 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 1069 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 1070 OR (lo > hi) THEN
|
|
|
+ 1071 SemError(230); ok := FALSE
|
|
|
+ 1072 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
+ 1073 SemError(230); ok := FALSE
|
|
|
+ 1074 END;
|
|
|
+ 1075 END; .) .
|
|
|
+ 1076 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
+ 1077 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
+ 1078 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
+ 1079 comparison across suitable bases are lenient (masks over min
|
|
|
+ 1080 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
+ 1081 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
+ 1082 blo, bhi, bspan: INTEGER;
|
|
|
+ 1083 bcls: INTEGER; .)
|
|
|
+ 1084 = "SET" "OF" Type<base, FALSE>
|
|
|
+ 1085 (. IF base = SymTab.InvalidType THEN
|
|
|
+ 1086 t := SymTab.InvalidType
|
|
|
+ 1087 ELSE bcls :=
|
|
|
+ 1088 SymTab.ClassOf(base);
|
|
|
+ 1089 IF bcls = SymTab.ClBool THEN
|
|
|
+ 1090 blo := 0; bspan := 2
|
|
|
+ 1091 ELSIF bcls = SymTab.ClChar THEN
|
|
|
+ 1092 blo := 0; bspan := 256
|
|
|
+ 1093 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
+ 1094 blo := 0;
|
|
|
+ 1095 bspan := VAL(INTEGER,
|
|
|
+ 1096 SymTab.EnumCount(base))
|
|
|
+ 1097 ELSIF SymTab.SubBounds(base,
|
|
|
+ 1098 blo, bhi) THEN
|
|
|
+ 1099 bspan := bhi - blo + 1
|
|
|
+ 1100 ELSE bspan := 0 END;
|
|
|
+ 1101 IF (bspan <= 0)
|
|
|
+ 1102 OR (bspan > 65536) THEN
|
|
|
+ 1103 SemError(230);
|
|
|
+ 1104 t := SymTab.InvalidType
|
|
|
+ 1105 ELSE t := SymTab.NewSet(base)
|
|
|
+ 1106 END
|
|
|
+ 1107 END; .) .
|
|
|
+ 1108 (* Records: flat blobs; array fields are pointers to static
|
|
|
+ 1109 descriptors (locked amendment), nested records inline. Field
|
|
|
+ 1110 offsets static and declaration-ordered. *)
|
|
|
+ 1111 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
+ 1112 variant part is a `CASE ... END` item; because it starts with the
|
|
|
+ 1113 CASE keyword it is unambiguously distinguishable from a field
|
|
|
+ 1114 (which starts with an identifier). *)
|
|
|
+ 1115 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 1116 tagOk: BOOLEAN; .)
|
|
|
+ 1117 = "RECORD" (. t := SymTab.NewRecord(); .)
|
|
|
+ 1118 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
+ 1119 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
+ 1120 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
+ 1121 = RecField<rec>
|
|
|
+ 1122 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
+ 1123 (* A variant part: CASE tag : Type OF variants. The layout overlays
|
|
|
+ 1124 every branch from the tag slot (see SymTab.ComputeOffsets). *)
|
|
|
+ 1125 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
+ 1126 tagN: SymTab.Name; .)
|
|
|
+ 1127 = "CASE" (. SymTab.ResetFields(rec); .)
|
|
|
+ 1128 GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1129 tagN) THEN
|
|
|
+ 1130 SemError(200) END; .)
|
|
|
+ 1131 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
+ 1132 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
+ 1133 SemError(224)
|
|
|
+ 1134 END;
|
|
|
+ 1135 SymTab.FixPendingF(rec, tagT);
|
|
|
+ 1136 SymTab.SetVariantTag(rec, tagN); .)
|
|
|
+ 1137 "OF"
|
|
|
+ 1138 RecFieldList<rec>
|
|
|
+ 1139 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
+ 1140 RecFieldList<rec> }
|
|
|
+ 1141 "END" .
|
|
|
+ 1142 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
+ 1143 lv1, lv2: QbeGen.QVal; .)
|
|
|
+ 1144 = VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] ":"
|
|
|
+ 1145 RecField<rec> { ";" [ RecField<rec> ] } .
|
|
|
+ 1146 (* Variant case label: a constant (or a constant range). Values are
|
|
|
+ 1147 not interpreted (the layout overlays regardless). *)
|
|
|
+ 1148 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 1149 (. VAR lname: SymTab.Name; .)
|
|
|
+ 1150 = ( ident (. LexName(lname);
|
|
|
+ 1151 QbeGen.CopyOp("0", q);
|
|
|
+ 1152 t := SymTab.IntType(); .)
|
|
|
+ 1153 | integer (. LexString(lname);
|
|
|
+ 1154 QbeGen.CopyOp("0", q);
|
|
|
+ 1155 t := SymTab.IntType(); .)
|
|
|
+ 1156 | charConst (. LexString(lname);
|
|
|
+ 1157 QbeGen.CopyOp("0", q);
|
|
|
+ 1158 t := SymTab.CharType(); .) ) .
|
|
|
+ 1159 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1160 t2: SymTab.TypeIndex; .)
|
|
|
+ 1161 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
+ 1162 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
+ 1163 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1164 n) THEN
|
|
|
+ 1165 SemError(200) END; .)
|
|
|
+ 1166 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1167 n) THEN
|
|
|
+ 1168 SemError(200) END; .) } .
|
|
|
+ 1169 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
+ 1170 k: INTEGER;
|
|
|
+ 1171 dotted: BOOLEAN; .)
|
|
|
+ 1172 = GetIdent<n> (. dotted := FALSE;
|
|
|
+ 1173 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 1174 k := -1;
|
|
|
+ 1175 t := SymTab.ForwardType(n);
|
|
|
+ 1176 IF t = SymTab.InvalidType THEN
|
|
|
+ 1177 SemError(201)
|
|
|
+ 1178 END
|
|
|
+ 1179 ELSE k := SymTab.SymKind(n);
|
|
|
+ 1180 IF (k = SymTab.KindType)
|
|
|
+ 1181 OR (k = SymTab.KindPredef) THEN
|
|
|
+ 1182 t := SymTab.SymType(n)
|
|
|
+ 1183 ELSE t := SymTab.InvalidType
|
|
|
+ 1184 END
|
|
|
+ 1185 END; .)
|
|
|
+ 1186 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
+ 1187 IF k = SymTab.KindModule THEN
|
|
|
+ 1188 t := SymTab.QualType(n, qid);
|
|
|
+ 1189 IF t = SymTab.InvalidType THEN
|
|
|
+ 1190 SemError(201)
|
|
|
+ 1191 END
|
|
|
+ 1192 ELSE SemError(221);
|
|
|
+ 1193 t := SymTab.InvalidType
|
|
|
+ 1194 END; .) ]
|
|
|
+ 1195 (. IF NOT dotted THEN
|
|
|
+ 1196 IF (k = SymTab.KindModule)
|
|
|
+ 1197 OR ((k # SymTab.KindType)
|
|
|
+ 1198 AND (k # SymTab.KindPredef)
|
|
|
+ 1199 AND (k # SymTab.KindImport)
|
|
|
+ 1200 AND (k # -1)) THEN
|
|
|
+ 1201 SemError(221)
|
|
|
+ 1202 END
|
|
|
+ 1203 END; .) .
|
|
|
+ 1204 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 1205 qlo, qhi: QbeGen.QVal;
|
|
|
+ 1206 lo, hi: INTEGER; .)
|
|
|
+ 1207 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 1208 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 1209 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 1210 t := SymTab.InvalidType
|
|
|
+ 1211 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
+ 1212 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
+ 1213 SemError(230);
|
|
|
+ 1214 t := SymTab.InvalidType
|
|
|
+ 1215 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 1216 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 1217 OR (lo > hi) THEN
|
|
|
+ 1218 SemError(230);
|
|
|
+ 1219 t := SymTab.InvalidType
|
|
|
+ 1220 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
+ 1221 END; .)
|
|
|
+ 1222 "]" .
|
|
|
+ 1223 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1224 ord: INTEGER;
|
|
|
+ 1225 qv: QbeGen.QVal; .)
|
|
|
+ 1226 = "(" (. t := SymTab.NewEnum();
|
|
|
+ 1227 ord := 0; .)
|
|
|
+ 1228 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1229 SymTab.KindConst) THEN
|
|
|
+ 1230 SemError(200) END;
|
|
|
+ 1231 SymTab.SetSymType(n, t);
|
|
|
+ 1232 QbeGen.IntStr(ord, qv);
|
|
|
+ 1233 SymTab.SetSymVal(n, qv);
|
|
|
+ 1234 Lower.NoteVar(n,
|
|
|
+ 1235 SymTab.KindConst, t);
|
|
|
+ 1236 Lower.NoteConstVal(qv);
|
|
|
+ 1237 INC(ord); .)
|
|
|
+ 1238 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1239 SymTab.KindConst) THEN
|
|
|
+ 1240 SemError(200) END;
|
|
|
+ 1241 SymTab.SetSymType(n, t);
|
|
|
+ 1242 QbeGen.IntStr(ord, qv);
|
|
|
+ 1243 SymTab.SetSymVal(n, qv);
|
|
|
+ 1244 Lower.NoteVar(n,
|
|
|
+ 1245 SymTab.KindConst, t);
|
|
|
+ 1246 Lower.NoteConstVal(qv);
|
|
|
+ 1247 INC(ord); .) }
|
|
|
+ 1248 ")" (. SymTab.SetEnumCount(t,
|
|
|
+ 1249 VAL(CARDINAL, ord)); .) .
|
|
|
+ 1250 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
+ 1251 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
+ 1252 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
+ 1253 class/impl block. Methods end with ";" per the Table example
|
|
|
+ 1254 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
+ 1255 (* Single CLASS item in both loops: separating declaration from
|
|
|
+ 1256 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
+ 1257 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
+ 1258 The second token decides after CLASS is consumed. A misplaced
|
|
|
+ 1259 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
+ 1260 whole unit ends 230 until lowering). *)
|
|
|
+ 1261 ClassItem
|
|
|
+ 1262 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
+ 1263 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
+ 1264 ct: SymTab.TypeIndex; .)
|
|
|
+ 1265 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
+ 1266 SymTab.KindType) THEN
|
|
|
+ 1267 SemError(200) END;
|
|
|
+ 1268 ct := SymTab.NewClass();
|
|
|
+ 1269 SymTab.SetSymType(cn, ct);
|
|
|
+ 1270 SymTab.PushClassScope(ct);
|
|
|
+ 1271 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1272 AST.SetChild(astCls, 0,
|
|
|
+ 1273 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1274 astClsP := AST.NoNode;
|
|
|
+ 1275 astClsPTail := AST.NoNode;
|
|
|
+ 1276 astClsF := AST.NoNode;
|
|
|
+ 1277 astClsFTail := AST.NoNode;
|
|
|
+ 1278 astClsM := AST.NoNode;
|
|
|
+ 1279 astClsMTail := AST.NoNode; .)
|
|
|
+ 1280 [ Parents<ct> ]
|
|
|
+ 1281 ";"
|
|
|
+ 1282 { ClassField<ct> ";" }
|
|
|
+ 1283 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 1284 (. Lower.ScopeLeave;
|
|
|
+ 1285 SymTab.CloseProc;
|
|
|
+ 1286 QbeGen.AbortFunc; .) }
|
|
|
+ 1287 "END"
|
|
|
+ 1288 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1289 SemError(202) END;
|
|
|
+ 1290 SymTab.LayoutClass(ct);
|
|
|
+ 1291 SymTab.PopScope;
|
|
|
+ 1292 AST.SetChild(astCls, 1, astClsP);
|
|
|
+ 1293 AST.SetChild(astCls, 2, astClsF);
|
|
|
+ 1294 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1295 astDecl := astCls; .) .
|
|
|
+ 1296 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
+ 1297 = "(" Parent1<ct>
|
|
|
+ 1298 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
+ 1299 ")" .
|
|
|
+ 1300 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
+ 1301 pt: SymTab.TypeIndex; .)
|
|
|
+ 1302 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
+ 1303 SemError(201)
|
|
|
+ 1304 ELSE pt := SymTab.SymType(p);
|
|
|
+ 1305 IF SymTab.ClassOf(pt) #
|
|
|
+ 1306 SymTab.ClClass THEN
|
|
|
+ 1307 SemError(230)
|
|
|
+ 1308 ELSE SymTab.SetParent(ct, pt)
|
|
|
+ 1309 END
|
|
|
+ 1310 END;
|
|
|
+ 1311 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1312 astClsP, astClsPTail,
|
|
|
+ 1313 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
+ 1314 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
+ 1315 t: SymTab.TypeIndex;
|
|
|
+ 1316 astNode: AST.Node; .)
|
|
|
+ 1317 = GetIdent<n>
|
|
|
+ 1318 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1319 SymTab.KindConst) THEN
|
|
|
+ 1320 SemError(200) END;
|
|
|
+ 1321 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1322 AST.SetChild(astNode, 0,
|
|
|
+ 1323 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1324 AST.SetChild(astNode, 1,
|
|
|
+ 1325 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
+ 1326 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1327 astClsF, astClsFTail, astNode);
|
|
|
+ 1328 IF SymTab.Lookup(rhs) THEN
|
|
|
+ 1329 SymTab.SetSymType(n,
|
|
|
+ 1330 SymTab.SymType(rhs))
|
|
|
+ 1331 END; .)
|
|
|
+ 1332 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1333 n) THEN
|
|
|
+ 1334 SemError(200) END;
|
|
|
+ 1335 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 1336 AST.SetChild(astNode, 0,
|
|
|
+ 1337 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1338 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1339 n) THEN
|
|
|
+ 1340 SemError(200) END;
|
|
|
+ 1341 AST.SetChild(astNode,
|
|
|
+ 1342 AST.NChild(astNode),
|
|
|
+ 1343 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
+ 1344 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
+ 1345 AST.SetTy(astNode, t);
|
|
|
+ 1346 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1347 astClsF, astClsFTail, astNode); .) ) .
|
|
|
+ 1348 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
+ 1349 (. VAR wantVirt: BOOLEAN; .)
|
|
|
+ 1350 = (. wantVirt := FALSE; .)
|
|
|
+ 1351 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
+ 1352 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
+ 1353 SymTab.MarkVirtual END;
|
|
|
+ 1354 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 1355 AST.SetChild(astMethod, 0,
|
|
|
+ 1356 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 1357 IF wantVirt THEN
|
|
|
+ 1358 AST.SetOp(astMethod, 3)
|
|
|
+ 1359 ELSE AST.SetOp(astMethod, 0)
|
|
|
+ 1360 END;
|
|
|
+ 1361 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1362 astClsM, astClsMTail, astMethod); .) .
|
|
|
+ 1363 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
+ 1364 ct: SymTab.TypeIndex; .)
|
|
|
+ 1365 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
+ 1366 SemError(201);
|
|
|
+ 1367 ct := SymTab.InvalidType
|
|
|
+ 1368 ELSE ct := SymTab.SymType(cn);
|
|
|
+ 1369 IF SymTab.ClassOf(ct) #
|
|
|
+ 1370 SymTab.ClClass THEN
|
|
|
+ 1371 SemError(230);
|
|
|
+ 1372 ct := SymTab.InvalidType
|
|
|
+ 1373 END
|
|
|
+ 1374 END;
|
|
|
+ 1375 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1376 AST.SetOp(astCls, 1);
|
|
|
+ 1377 AST.SetChild(astCls, 0,
|
|
|
+ 1378 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1379 astClsM := AST.NoNode;
|
|
|
+ 1380 astClsMTail := AST.NoNode;
|
|
|
+ 1381 astStmt := AST.NoNode;
|
|
|
+ 1382 IF ct #
|
|
|
+ 1383 SymTab.InvalidType THEN
|
|
|
+ 1384 IF NOT SymTab.PushClassMembers(
|
|
|
+ 1385 ct) THEN
|
|
|
+ 1386 SemError(230) END;
|
|
|
+ 1387 SymTab.PushImplClass(ct)
|
|
|
+ 1388 END; .)
|
|
|
+ 1389 ";" { MethodImpl<ct> ";" }
|
|
|
+ 1390 (. astStmt := AST.NoNode; .)
|
|
|
+ 1391 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
+ 1392 .)
|
|
|
+ 1393 [ StatSeq ] ]
|
|
|
+ 1394 "END"
|
|
|
+ 1395 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1396 SemError(202) END;
|
|
|
+ 1397 SymTab.PopImplClass;
|
|
|
+ 1398 SymTab.PopScope;
|
|
|
+ 1399 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
+ 1400 AST.SetChild(astCls, 2, astStmt);
|
|
|
+ 1401 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1402 astDecl := astCls; .) .
|
|
|
+ 1403 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
+ 1404 thisQ: QbeGen.QVal;
|
|
|
+ 1405 methRes: SymTab.TypeIndex; .)
|
|
|
+ 1406 = MethodHeading<pn, ct> ";"
|
|
|
+ 1407 (. IF (ct #
|
|
|
+ 1408 SymTab.InvalidType)
|
|
|
+ 1409 AND NOT SymTab.MethodExists(ct,
|
|
|
+ 1410 pn) THEN
|
|
|
+ 1411 SemError(201) END; .)
|
|
|
+ 1412 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
+ 1413 SymTab.MarkFwd;
|
|
|
+ 1414 QbeGen.AbortFunc;
|
|
|
+ 1415 Lower.ScopeLeave;
|
|
|
+ 1416 SymTab.CloseProc; .)
|
|
|
+ 1417 | (.
|
|
|
+ 1418 (* bind the receiver: bare
|
|
|
+ 1419 field names resolve
|
|
|
+ 1420 against THIS *)
|
|
|
+ 1421 QbeGen.CopyOp("@", thisQ);
|
|
|
+ 1422 QbeGen.PushWith(thisQ); .)
|
|
|
+ 1423 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
+ 1424 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
+ 1425 QbeGen.PopWith;
|
|
|
+ 1426 methRes := SymTab.CurRes();
|
|
|
+ 1427 Lower.ScopeLeave;
|
|
|
+ 1428 SymTab.CloseProc;
|
|
|
+ 1429 QbeGen.EndFunc(methRes); .) ) .
|
|
|
+ 1430 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1431 = "CONST" (. astSeq := AST.NoNode;
|
|
|
+ 1432 astTail := AST.NoNode; .)
|
|
|
+ 1433 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1434 astSeq, astTail, astDecl); .) }
|
|
|
+ 1435 (. astDecl := astSeq; .) .
|
|
|
+ 1436 ConstDecl (. VAR n: SymTab.Name;
|
|
|
+ 1437 t: SymTab.TypeIndex;
|
|
|
+ 1438 qv: QbeGen.QVal;
|
|
|
+ 1439 cls: INTEGER;
|
|
|
+ 1440 astNode: AST.Node; .)
|
|
|
+ 1441 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1442 SymTab.KindConst) THEN
|
|
|
+ 1443 SemError(200) END; .)
|
|
|
+ 1444 "="
|
|
|
+ 1445 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1446 AST.SetChild(astNode, 0,
|
|
|
+ 1447 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1448 AST.SetChild(astNode, 1, astCur);
|
|
|
+ 1449 AST.SetTy(astNode, t);
|
|
|
+ 1450 astDecl := astNode;
|
|
|
+ 1451 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
+ 1452 Lower.NoteConstVal(qv);
|
|
|
+ 1453 SymTab.SetSymType(n, t);
|
|
|
+ 1454 cls := SymTab.ClassOf(t);
|
|
|
+ 1455 IF (cls = SymTab.ClArray)
|
|
|
+ 1456 OR (cls = SymTab.ClRecord)
|
|
|
+ 1457 OR (cls = SymTab.ClClass)
|
|
|
+ 1458 OR (cls = SymTab.ClStr)
|
|
|
+ 1459 OR (cls = SymTab.ClUStr) THEN
|
|
|
+ 1460 (* an aggregate/string
|
|
|
+ 1461 constant: qv is its
|
|
|
+ 1462 descriptor address; no
|
|
|
+ 1463 scalar data *)
|
|
|
+ 1464 SymTab.SetSymVal(n, qv)
|
|
|
+ 1465 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
+ 1466 SemError(230)
|
|
|
+ 1467 ELSE
|
|
|
+ 1468 SymTab.SetSymVal(n, qv);
|
|
|
+ 1469 END; .) .
|
|
|
+ 1470 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1471 = "VAR" (. astSeq := AST.NoNode;
|
|
|
+ 1472 astTail := AST.NoNode; .)
|
|
|
+ 1473 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1474 astSeq, astTail, astDecl); .) }
|
|
|
+ 1475 (. astDecl := astSeq; .) .
|
|
|
+ 1476 VarDecl (. VAR nm: SymTab.Name;
|
|
|
+ 1477 t: SymTab.TypeIndex;
|
|
|
+ 1478 i: CARDINAL;
|
|
|
+ 1479 cls: INTEGER;
|
|
|
+ 1480 astNode, astTail: AST.Node; .)
|
|
|
+ 1481 = VarIdents ":"
|
|
|
+ 1482 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 1483 astTail := astNode;
|
|
|
+ 1484 i := 0;
|
|
|
+ 1485 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1486 SymTab.PendName(i, nm);
|
|
|
+ 1487 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
+ 1488 (* chunked: a VAR list can
|
|
|
+ 1489 exceed AST.MaxChild *)
|
|
|
+ 1490 AstAppend(AST.NkBlock,
|
|
|
+ 1491 astNode, astTail,
|
|
|
+ 1492 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
+ 1493 INC(i)
|
|
|
+ 1494 END;
|
|
|
+ 1495 AST.SetTy(astNode, t);
|
|
|
+ 1496 astDecl := astNode;
|
|
|
+ 1497 cls := SymTab.ClassOf(t);
|
|
|
+ 1498 IF (t # SymTab.InvalidType)
|
|
|
+ 1499 AND NOT SymTab.IsUnresolved(t)
|
|
|
+ 1500 AND (cls # SymTab.ClInt)
|
|
|
+ 1501 AND (cls # SymTab.ClBool)
|
|
|
+ 1502 AND (cls # SymTab.ClChar)
|
|
|
+ 1503 AND (cls # SymTab.ClReal)
|
|
|
+ 1504 AND (cls # SymTab.ClArray)
|
|
|
+ 1505 AND (cls # SymTab.ClSet)
|
|
|
+ 1506 AND (cls # SymTab.ClRecord)
|
|
|
+ 1507 AND (cls # SymTab.ClPtr)
|
|
|
+ 1508 AND (cls # SymTab.ClLong)
|
|
|
+ 1509 AND (cls # SymTab.ClProc)
|
|
|
+ 1510 AND (cls # SymTab.ClUChar)
|
|
|
+ 1511 AND (cls # SymTab.ClUStr)
|
|
|
+ 1512 AND (cls # SymTab.ClEnum)
|
|
|
+ 1513 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 1514 SemError(230) END;
|
|
|
+ 1515 IF QbeGen.LocFull() THEN
|
|
|
+ 1516 SemError(233) END;
|
|
|
+ 1517 i := 0;
|
|
|
+ 1518 IF SymTab.IsUnresolved(t)
|
|
|
+ 1519 AND NOT SymTab.InProc() THEN
|
|
|
+ 1520 (* a forward-typed global:
|
|
|
+ 1521 defer emission until the
|
|
|
+ 1522 TYPE block completes *)
|
|
|
+ 1523 AST.SetOp(astNode, 1);
|
|
|
+ 1524 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1525 SymTab.PendName(i, nm);
|
|
|
+ 1526 IF nPendVar <=
|
|
|
+ 1527 HIGH(pendVarName) THEN
|
|
|
+ 1528 pendVarName[nPendVar] := nm;
|
|
|
+ 1529 pendVarT[nPendVar] := t;
|
|
|
+ 1530 INC(nPendVar)
|
|
|
+ 1531 END;
|
|
|
+ 1532 INC(i)
|
|
|
+ 1533 END
|
|
|
+ 1534 ELSE
|
|
|
+ 1535 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1536 SymTab.PendName(i, nm);
|
|
|
+ 1537 INC(i)
|
|
|
+ 1538 END
|
|
|
+ 1539 END;
|
|
|
+ 1540 (* a plain VAR list, not a
|
|
|
+ 1541 heading: the signature
|
|
|
+ 1542 result is discarded *)
|
|
|
+ 1543 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 1544 END; .) .
|
|
|
+ 1545 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
+ 1546 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 1547 SymTab.KindVar) THEN
|
|
|
+ 1548 SemError(200) END; .)
|
|
|
+ 1549 { ","
|
|
|
+ 1550 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 1551 SymTab.KindVar) THEN
|
|
|
+ 1552 SemError(200) END; .) } .
|
|
|
+ 1553 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
+ 1554 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 1555 SemError(200) END; .)
|
|
|
+ 1556 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 1557 SemError(200) END; .) } .
|
|
|
+ 1558 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
+ 1559 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
+ 1560 FORWARD marks; the body heading re-enters (signature compare
|
|
|
+ 1561 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
+ 1562 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
+ 1563 (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1564 mg: QbeGen.QVal; .)
|
|
|
+ 1565 = "PROCEDURE"
|
|
|
+ 1566 GetIdent<pn> (. IF methCls #
|
|
|
+ 1567 SymTab.InvalidType THEN
|
|
|
+ 1568 (* a method: resume the
|
|
|
+ 1569 declared symbol (reuse
|
|
|
+ 1570 its uid) *)
|
|
|
+ 1571 IF NOT SymTab.ResumeMethod(
|
|
|
+ 1572 methCls, pn) THEN
|
|
|
+ 1573 SemError(200) END
|
|
|
+ 1574 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
+ 1575 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
+ 1576 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
+ 1577 SemError(200) END
|
|
|
+ 1578 END
|
|
|
+ 1579 END;
|
|
|
+ 1580 Lower.ScopeEnter;
|
|
|
+ 1581 Lower.NoteProc(pn,
|
|
|
+ 1582 SymTab.ProcUid(pn),
|
|
|
+ 1583 SymTab.InvalidType,
|
|
|
+ 1584 SymTab.ProcDepthOf(pn),
|
|
|
+ 1585 FALSE);
|
|
|
+ 1586 QbeGen.BeginFunc("");
|
|
|
+ 1587 IF methCls #
|
|
|
+ 1588 SymTab.InvalidType THEN
|
|
|
+ 1589 (* hidden THIS receiver:
|
|
|
+ 1590 a VAR param of the
|
|
|
+ 1591 class type, pushed as
|
|
|
+ 1592 the WITH base *)
|
|
|
+ 1593 IF NOT SymTab.EnterThisParam(
|
|
|
+ 1594 methCls) THEN
|
|
|
+ 1595 SemError(200) END;
|
|
|
+ 1596 IF NOT QbeGen.FuncParam(
|
|
|
+ 1597 "THIS", TRUE,
|
|
|
+ 1598 methCls) THEN
|
|
|
+ 1599 SemError(233) END
|
|
|
+ 1600 END; .)
|
|
|
+ 1601 [ FormalParams ]
|
|
|
+ 1602 [ ":" TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
+ 1603 SemError(235) END;
|
|
|
+ 1604 Lower.SetProcRes(t); .) ] .
|
|
|
+ 1605 FormalParams
|
|
|
+ 1606 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
+ 1607 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1608 nm: SymTab.Name;
|
|
|
+ 1609 i: CARDINAL;
|
|
|
+ 1610 isV: BOOLEAN; .)
|
|
|
+ 1611 = (. isV := FALSE; .)
|
|
|
+ 1612 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 1613 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
+ 1614 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1615 SymTab.PendName(i, nm);
|
|
|
+ 1616 Lower.NoteParam(nm, t, isV);
|
|
|
+ 1617 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
+ 1618 (* value open arrays are
|
|
|
+ 1619 passed as descriptor
|
|
|
+ 1620 addresses (no copy):
|
|
|
+ 1621 same representation as
|
|
|
+ 1622 VAR formals *)
|
|
|
+ 1623 IF NOT QbeGen.FuncParam(nm,
|
|
|
+ 1624 isV
|
|
|
+ 1625 OR SymTab.IsOpenArray(t),
|
|
|
+ 1626 t) THEN
|
|
|
+ 1627 SemError(233) END;
|
|
|
+ 1628 INC(i)
|
|
|
+ 1629 END;
|
|
|
+ 1630 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 1631 SemError(235) END; .) .
|
|
|
+ 1632 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
+ 1633 static link gives them their parent's frame. Methods keep
|
|
|
+ 1634 parse-now/230-later. *)
|
|
|
+ 1635 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
+ 1636 astNode: AST.Node; .)
|
|
|
+ 1637 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 1638 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 1639 AST.SetOp(astNode, 0);
|
|
|
+ 1640 AST.SetChild(astNode, 0,
|
|
|
+ 1641 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 1642 Lower.NoteProcNode(astNode); .)
|
|
|
+ 1643 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
+ 1644 astDecl := astNode;
|
|
|
+ 1645 Lower.ScopeLeave;
|
|
|
+ 1646 SymTab.MarkFwd;
|
|
|
+ 1647 SymTab.CloseProc;
|
|
|
+ 1648 QbeGen.AbortFunc; .)
|
|
|
+ 1649 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
+ 1650 astDecl := astNode;
|
|
|
+ 1651 Lower.MarkProcExternal;
|
|
|
+ 1652 Lower.ScopeLeave;
|
|
|
+ 1653 SymTab.MarkExternal("");
|
|
|
+ 1654 SymTab.CloseProc;
|
|
|
+ 1655 QbeGen.AbortFunc; .)
|
|
|
+ 1656 |
|
|
|
+ 1657 (. allowDefer := TRUE; deferredBody := FALSE;
|
|
|
+ 1658 curProcNode := astNode; .)
|
|
|
+ 1659 Block<pn> (. IF deferredBody THEN
|
|
|
+ 1660 (* body skipped: close like
|
|
|
+ 1661 FORWARD (no body node) *)
|
|
|
+ 1662 astDecl := astNode;
|
|
|
+ 1663 Lower.ScopeLeave;
|
|
|
+ 1664 SymTab.CloseProc;
|
|
|
+ 1665 QbeGen.AbortFunc
|
|
|
+ 1666 ELSE
|
|
|
+ 1667 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 1668 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
+ 1669 astDecl := astNode;
|
|
|
+ 1670 Lower.ScopeLeave;
|
|
|
+ 1671 SymTab.CloseProc;
|
|
|
+ 1672 QbeGen.EndFunc(
|
|
|
+ 1673 SymTab.ProcRes(pn))
|
|
|
+ 1674 END; .) ) .
|
|
|
+ 1675 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN; .)
|
|
|
+ 1676 = (. dfr := FALSE;
|
|
|
+ 1677 IF allowDefer AND twoPhaseParse
|
|
|
+ 1678 AND NOT repassing THEN
|
|
|
+ 1679 dfr := DeferSkip(pn)
|
|
|
1680 END;
|
|
|
- 1681 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 1682 SemError(235) END; .) .
|
|
|
- 1683 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
- 1684 static link gives them their parent's frame. Methods keep
|
|
|
- 1685 parse-now/230-later. *)
|
|
|
- 1686 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
- 1687 astNode: AST.Node; .)
|
|
|
- 1688 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 1689 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 1690 AST.SetOp(astNode, 0);
|
|
|
- 1691 AST.SetChild(astNode, 0,
|
|
|
- 1692 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 1693 Lower.NoteProcNode(astNode); .)
|
|
|
- 1694 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
- 1695 astDecl := astNode;
|
|
|
- 1696 Lower.ScopeLeave;
|
|
|
- 1697 SymTab.MarkFwd;
|
|
|
- 1698 SymTab.CloseProc;
|
|
|
- 1699 QbeGen.AbortFunc; .)
|
|
|
- 1700 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
- 1701 astDecl := astNode;
|
|
|
- 1702 Lower.MarkProcExternal;
|
|
|
- 1703 Lower.ScopeLeave;
|
|
|
- 1704 SymTab.MarkExternal("");
|
|
|
- 1705 SymTab.CloseProc;
|
|
|
- 1706 QbeGen.AbortFunc; .)
|
|
|
- 1707 |
|
|
|
- 1708 (. allowDefer := TRUE; deferredBody := FALSE;
|
|
|
- 1709 curProcNode := astNode; .)
|
|
|
- 1710 Block<pn> (. IF deferredBody THEN
|
|
|
- 1711 (* body skipped: close like
|
|
|
- 1712 FORWARD (no body node) *)
|
|
|
- 1713 astDecl := astNode;
|
|
|
- 1714 Lower.ScopeLeave;
|
|
|
- 1715 SymTab.CloseProc;
|
|
|
- 1716 QbeGen.AbortFunc
|
|
|
- 1717 ELSE
|
|
|
- 1718 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 1719 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
- 1720 astDecl := astNode;
|
|
|
- 1721 Lower.ScopeLeave;
|
|
|
- 1722 SymTab.CloseProc;
|
|
|
- 1723 QbeGen.EndFunc(
|
|
|
- 1724 SymTab.ProcRes(pn))
|
|
|
- 1725 END; .) ) .
|
|
|
- 1726 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN; .)
|
|
|
- 1727 = (. dfr := FALSE;
|
|
|
- 1728 IF allowDefer AND twoPhaseParse
|
|
|
- 1729 AND NOT repassing THEN
|
|
|
- 1730 dfr := DeferSkip(pn)
|
|
|
- 1731 END;
|
|
|
- 1732 allowDefer := FALSE;
|
|
|
- 1733 IF NOT dfr THEN INC(procNest) END; .)
|
|
|
- 1734 DeclSeq (. astBlkDecls := astDecl;
|
|
|
- 1735 astStmt := AST.NoNode;
|
|
|
- 1736 nLab := 0; nGot := 0; .)
|
|
|
- 1737 [ "BEGIN" (. (* an empty body is still a
|
|
|
- 1738 body: mark it so Lower
|
|
|
- 1739 does not read it as a
|
|
|
- 1740 definition heading *)
|
|
|
- 1741 IF NOT dfr THEN
|
|
|
- 1742 IF astStmt = AST.NoNode THEN
|
|
|
- 1743 astStmt :=
|
|
|
- 1744 AST.MakeNode(AST.NkBlock)
|
|
|
- 1745 END
|
|
|
- 1746 END; .)
|
|
|
- 1747 [ StatSeq ] ]
|
|
|
- 1748 "END"
|
|
|
- 1749 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
- 1750 SemError(202) END;
|
|
|
- 1751 IF NOT dfr THEN DEC(procNest) END;
|
|
|
- 1752 CheckGotos; .) .
|
|
|
- 1753 (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
|
|
|
- 1754 level body once the unit's declarations are complete. Inlined at
|
|
|
- 1755 both call sites because a stand-alone epsilon production is
|
|
|
- 1756 "unreachable" to Coco/R (referenced only from actions). *)
|
|
|
- 1757 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1758 = (. astSeq := AST.NoNode;
|
|
|
- 1759 astTail := AST.NoNode; .)
|
|
|
- 1760 Statement (. AstAppend(AST.NkBlock,
|
|
|
- 1761 astSeq, astTail, astStmt); .)
|
|
|
- 1762 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
- 1763 astSeq, astTail, astStmt); .) ] }
|
|
|
- 1764 (. astStmt := astSeq; .) .
|
|
|
- 1765 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
- 1766 are accepted: the statement after ';' is optional. *)
|
|
|
- 1767 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
- 1768 = (. astStmt := AST.NoNode; .)
|
|
|
- 1769 ( AssOrCall
|
|
|
- 1770 | IfStat
|
|
|
- 1771 | WhileStat
|
|
|
- 1772 | RepeatStat
|
|
|
- 1773 | LoopStat
|
|
|
- 1774 | ForStat
|
|
|
- 1775 | CaseStat
|
|
|
- 1776 | WithStat
|
|
|
- 1777 | ReturnStat
|
|
|
- 1778 | HaltStat
|
|
|
- 1779 | NewStat
|
|
|
- 1780 | DisposeStat
|
|
|
- 1781 | IncDecStat
|
|
|
- 1782 | InclExclStat
|
|
|
- 1783 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
- 1784 SemError(230) END;
|
|
|
- 1785 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
- 1786 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
- 1787 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
- 1788 AST.SetChild(astStmt, 0,
|
|
|
- 1789 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
- 1790 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
- 1791 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
- 1792 dk: INTEGER;
|
|
|
- 1793 qd, qe: QbeGen.QVal;
|
|
|
- 1794 qn: SymTab.Name;
|
|
|
- 1795 sfx, isInc: BOOLEAN;
|
|
|
- 1796 astNode, astD: AST.Node; .)
|
|
|
- 1797 = ( "INCL" (. isInc := TRUE; .)
|
|
|
- 1798 | "EXCL" (. isInc := FALSE; .) )
|
|
|
- 1799 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
- 1800 Expr<et2, qe> ")"
|
|
|
- 1801 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1802 IF isInc THEN
|
|
|
- 1803 AST.SetChild(astNode, 0,
|
|
|
- 1804 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
- 1805 ELSE AST.SetChild(astNode, 0,
|
|
|
- 1806 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
- 1807 END;
|
|
|
- 1808 IF astD # AST.NoNode THEN
|
|
|
- 1809 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1810 IF astCur # AST.NoNode THEN
|
|
|
- 1811 AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 1812 astStmt := astNode; .)
|
|
|
- 1813 (. IF (at # SymTab.InvalidType)
|
|
|
- 1814 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
- 1815 SemError(222)
|
|
|
- 1816 END; .) .
|
|
|
- 1817 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
- 1818 integer designator. *)
|
|
|
- 1819 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
- 1820 dk: INTEGER;
|
|
|
- 1821 qd, qv, qn2, qstep:
|
|
|
- 1822 QbeGen.QVal;
|
|
|
- 1823 qn: SymTab.Name;
|
|
|
- 1824 sfx, isInc: BOOLEAN;
|
|
|
- 1825 astNode, astD, astStep:
|
|
|
- 1826 AST.Node; .)
|
|
|
- 1827 = (. isInc := TRUE; .)
|
|
|
- 1828 ( "INC" (. isInc := TRUE; .)
|
|
|
- 1829 | "DEC" (. isInc := FALSE; .) )
|
|
|
- 1830 "(" (. astStep := AST.NoNode; .)
|
|
|
- 1831 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
- 1832 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
- 1833 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1834 IF isInc THEN
|
|
|
- 1835 AST.SetChild(astNode, 0,
|
|
|
- 1836 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
- 1837 ELSE AST.SetChild(astNode, 0,
|
|
|
- 1838 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
- 1839 END;
|
|
|
- 1840 IF astD # AST.NoNode THEN
|
|
|
- 1841 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1842 IF astStep # AST.NoNode THEN
|
|
|
- 1843 AST.SetChild(astNode, 2, astStep) END;
|
|
|
- 1844 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
- 1845 ELSIF (dk # SymTab.KindVar)
|
|
|
- 1846 AND (dk # SymTab.KindParam)
|
|
|
- 1847 AND (dk # SymTab.KindField) THEN
|
|
|
- 1848 SemError(210)
|
|
|
- 1849 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
- 1850 SemError(211)
|
|
|
- 1851 END; .) .
|
|
|
- 1852 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
- 1853 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
- 1854 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
- 1855 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 1856 dk: INTEGER;
|
|
|
- 1857 qd, qm: QbeGen.QVal;
|
|
|
- 1858 qn: SymTab.Name;
|
|
|
- 1859 sfx: BOOLEAN;
|
|
|
- 1860 bt: SymTab.TypeIndex;
|
|
|
- 1861 astNode, astD: AST.Node; .)
|
|
|
- 1862 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 1863 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1864 AST.SetChild(astNode, 0,
|
|
|
- 1865 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
- 1866 IF astD # AST.NoNode THEN
|
|
|
- 1867 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1868 astStmt := astNode; .)
|
|
|
- 1869 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 1870 ELSIF (dk # SymTab.KindVar)
|
|
|
- 1871 AND (dk # SymTab.KindParam)
|
|
|
- 1872 AND (dk # SymTab.KindField) THEN
|
|
|
- 1873 SemError(210)
|
|
|
- 1874 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 1875 SymTab.ClPtr THEN
|
|
|
- 1876 SemError(219)
|
|
|
- 1877 END; .) .
|
|
|
- 1878 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 1879 dk: INTEGER;
|
|
|
- 1880 qd, qv: QbeGen.QVal;
|
|
|
- 1881 qn: SymTab.Name;
|
|
|
- 1882 sfx: BOOLEAN;
|
|
|
- 1883 astNode, astD: AST.Node; .)
|
|
|
- 1884 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 1885 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1886 AST.SetChild(astNode, 0,
|
|
|
- 1887 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
- 1888 IF astD # AST.NoNode THEN
|
|
|
- 1889 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1890 astStmt := astNode; .)
|
|
|
- 1891 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 1892 ELSIF (dk # SymTab.KindVar)
|
|
|
- 1893 AND (dk # SymTab.KindParam)
|
|
|
- 1894 AND (dk # SymTab.KindField) THEN
|
|
|
- 1895 SemError(210)
|
|
|
- 1896 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 1897 SymTab.ClPtr THEN
|
|
|
- 1898 SemError(219)
|
|
|
- 1899 END; .) .
|
|
|
- 1900 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
- 1901 address; field designators resolve through both stacks. *)
|
|
|
- 1902 WithStat (. VAR nW: CARDINAL;
|
|
|
- 1903 astNode: AST.Node; .)
|
|
|
- 1904 = "WITH" (. nW := 0;
|
|
|
- 1905 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
- 1906 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
- 1907 "DO" (. astStmt := AST.NoNode; .)
|
|
|
- 1908 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
- 1909 AST.NChild(astNode), astStmt);
|
|
|
- 1910 astStmt := astNode;
|
|
|
- 1911 WHILE nW > 0 DO
|
|
|
- 1912 SymTab.PopScope;
|
|
|
- 1913 QbeGen.PopWith;
|
|
|
- 1914 DEC(nW)
|
|
|
- 1915 END; .) .
|
|
|
- 1916 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
- 1917 (. VAR dt: SymTab.TypeIndex;
|
|
|
- 1918 dk: INTEGER;
|
|
|
- 1919 qd, qe: QbeGen.QVal;
|
|
|
- 1920 qn: SymTab.Name;
|
|
|
- 1921 sfx: BOOLEAN; .)
|
|
|
- 1922 = Design<dt, dk, qd, qn, sfx>
|
|
|
- 1923 (. IF astCur # AST.NoNode THEN
|
|
|
- 1924 AST.SetChild(wnode,
|
|
|
- 1925 AST.NChild(wnode), astCur) END;
|
|
|
- 1926 IF dt = SymTab.InvalidType THEN
|
|
|
- 1927 ELSIF (SymTab.ClassOf(dt) #
|
|
|
- 1928 SymTab.ClRecord)
|
|
|
- 1929 AND (SymTab.ClassOf(dt) #
|
|
|
- 1930 SymTab.ClClass) THEN
|
|
|
- 1931 SemError(215)
|
|
|
- 1932 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
- 1933 QbeGen.PushWith(qd);
|
|
|
- 1934 INC(nW)
|
|
|
- 1935 END; .) .
|
|
|
- 1936 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
- 1937 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
- 1938 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
- 1939 dk: INTEGER;
|
|
|
- 1940 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
- 1941 qn: SymTab.Name;
|
|
|
- 1942 ct2, res0: SymTab.TypeIndex;
|
|
|
- 1943 q2, mg0: QbeGen.QVal;
|
|
|
- 1944 isR, conv, wconv: BOOLEAN;
|
|
|
- 1945 called, sfx: BOOLEAN;
|
|
|
- 1946 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
- 1947 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
- 1948 = GetIdent<n>
|
|
|
- 1949 ( ":" (. NoteLabel(n);
|
|
|
- 1950 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
- 1951 AST.SetChild(astNode, 0,
|
|
|
- 1952 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1953 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
- 1954 AST.SetChild(astLab, 0, astNode); .)
|
|
|
- 1955 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
- 1956 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
- 1957 astStmt := astLab; .)
|
|
|
- 1958 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
- 1959 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
- 1960 ( ":="
|
|
|
- 1961 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 1962 AST.NkAssign, 0, astLhs, astCur);
|
|
|
- 1963 IF (dt # SymTab.InvalidType)
|
|
|
- 1964 AND (dk # SymTab.KindVar)
|
|
|
- 1965 AND (dk # SymTab.KindParam)
|
|
|
- 1966 AND (dk # SymTab.KindField) THEN
|
|
|
- 1967 SemError(210)
|
|
|
- 1968 ELSIF NOT SymTab.Assignable(et,
|
|
|
- 1969 dt) THEN
|
|
|
- 1970 SemError(210)
|
|
|
- 1971 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 1972 AND (SymTab.ClassOf(dt) =
|
|
|
- 1973 SymTab.ClClass) THEN
|
|
|
- 1974 SemError(230) END;
|
|
|
- 1975 isR := (dt #
|
|
|
- 1976 SymTab.InvalidType)
|
|
|
- 1977 AND (SymTab.ClassOf(dt)
|
|
|
- 1978 = SymTab.ClReal);
|
|
|
- 1979 conv := isR
|
|
|
- 1980 AND SymTab.IsIntFamily(et);
|
|
|
- 1981 wconv := (dt #
|
|
|
- 1982 SymTab.InvalidType)
|
|
|
- 1983 AND SymTab.IsLongFamily(dt)
|
|
|
- 1984 AND SymTab.IsIntFamily(et);
|
|
|
- 1985 IF ((dk = SymTab.KindVar)
|
|
|
- 1986 OR (dk = SymTab.KindParam)
|
|
|
- 1987 OR (dk = SymTab.KindField))
|
|
|
- 1988 AND (dt # SymTab.InvalidType)
|
|
|
- 1989 AND (et # SymTab.InvalidType)
|
|
|
- 1990 AND (SymTab.ClassOf(dt) #
|
|
|
- 1991 SymTab.ClClass) THEN
|
|
|
- 1992 END; .)
|
|
|
- 1993 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
- 1994 (. astRes := AstCallNode(astLhs);
|
|
|
- 1995 sfx := FALSE; .)
|
|
|
- 1996 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
- 1997 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 1998 AST.NkAssign, 0, astRes, astCur);
|
|
|
- 1999 IF NOT sfx THEN
|
|
|
- 2000 SemError(233)
|
|
|
- 2001 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
- 2002 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
- 2003 SemError(210)
|
|
|
- 2004 END; .)
|
|
|
- 2005 | (. IF ct2 #
|
|
|
- 2006 SymTab.InvalidType THEN
|
|
|
- 2007 SemError(233) END;
|
|
|
- 2008 astStmt := astRes; .) )
|
|
|
- 2009 | (* bare `P;`: proper parameterless
|
|
|
- 2010 procedure call; anything else
|
|
|
- 2011 here is 233 (was a bare syntax
|
|
|
- 2012 error before 4.2) *)
|
|
|
- 2013 (. astStmt := AstCallNode(astLhs);
|
|
|
- 2014 IF (dk = SymTab.KindProc)
|
|
|
- 2015 AND NOT sfx THEN
|
|
|
- 2016 res0 := SymTab.ProcRes(qn);
|
|
|
- 2017 IF res0 #
|
|
|
- 2018 SymTab.InvalidType THEN
|
|
|
- 2019 SemError(233)
|
|
|
- 2020 ELSIF SymTab.ProcNPar(qn) #
|
|
|
- 2021 0 THEN
|
|
|
- 2022 SemError(233)
|
|
|
- 2023 END
|
|
|
- 2024 ELSE SemError(233)
|
|
|
- 2025 END; .) ) ) .
|
|
|
- 2026 (* Actual-parameter list shared by statement and expression calls.
|
|
|
- 2027 want selects CallEnd's result handling; t/q carry the call
|
|
|
- 2028 value (statement calls discard). Arity/type failures are 233;
|
|
|
- 2029 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
- 2030 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
- 2031 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
- 2032 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 2033 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
- 2034 vs: INTEGER;
|
|
|
- 2035 res: SymTab.TypeIndex;
|
|
|
- 2036 mg: QbeGen.QVal;
|
|
|
- 2037 ok, ind, isMeth, va: BOOLEAN; .)
|
|
|
- 2038 = "(" (. called := TRUE;
|
|
|
- 2039 ok := TRUE;
|
|
|
- 2040 ind := FALSE;
|
|
|
- 2041 isMeth := methCls #
|
|
|
- 2042 SymTab.InvalidType;
|
|
|
- 2043 IF isMeth THEN
|
|
|
- 2044 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
- 2045 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
- 2046 res := SymTab.ProcRes(pn)
|
|
|
- 2047 ELSIF (pt # SymTab.InvalidType)
|
|
|
- 2048 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
- 2049 ind := TRUE;
|
|
|
- 2050 res := SymTab.ProcTypeRes(pt)
|
|
|
- 2051 ELSE SemError(233);
|
|
|
- 2052 ok := FALSE;
|
|
|
- 2053 res := SymTab.InvalidType
|
|
|
- 2054 END;
|
|
|
- 2055 i := 0; .)
|
|
|
- 2056 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
- 2057 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
- 2058 ")" (. IF ok THEN
|
|
|
- 2059 IF isMeth THEN
|
|
|
- 2060 np := SymTab.ClassMethodNPar(
|
|
|
- 2061 methCls, pn)
|
|
|
- 2062 ELSIF ind THEN
|
|
|
- 2063 np := SymTab.ProcTypeNPar(pt)
|
|
|
- 2064 ELSE np := SymTab.ProcNPar(pn)
|
|
|
- 2065 END;
|
|
|
- 2066 va := (NOT isMeth) AND (NOT ind)
|
|
|
- 2067 AND (SymTab.SymKind(pn) =
|
|
|
- 2068 SymTab.KindProc)
|
|
|
- 2069 AND SymTab.Varargs(pn);
|
|
|
- 2070 IF (i # np) AND NOT va THEN
|
|
|
- 2071 SemError(233); ok := FALSE
|
|
|
- 2072 END
|
|
|
+ 1681 allowDefer := FALSE;
|
|
|
+ 1682 IF NOT dfr THEN INC(procNest) END; .)
|
|
|
+ 1683 DeclSeq (. astBlkDecls := astDecl;
|
|
|
+ 1684 astStmt := AST.NoNode;
|
|
|
+ 1685 nLab := 0; nGot := 0; .)
|
|
|
+ 1686 [ "BEGIN" (. (* an empty body is still a
|
|
|
+ 1687 body: mark it so Lower
|
|
|
+ 1688 does not read it as a
|
|
|
+ 1689 definition heading *)
|
|
|
+ 1690 IF NOT dfr THEN
|
|
|
+ 1691 IF astStmt = AST.NoNode THEN
|
|
|
+ 1692 astStmt :=
|
|
|
+ 1693 AST.MakeNode(AST.NkBlock)
|
|
|
+ 1694 END
|
|
|
+ 1695 END; .)
|
|
|
+ 1696 [ StatSeq ] ]
|
|
|
+ 1697 "END"
|
|
|
+ 1698 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
+ 1699 SemError(202) END;
|
|
|
+ 1700 IF NOT dfr THEN DEC(procNest) END;
|
|
|
+ 1701 CheckGotos; .) .
|
|
|
+ 1702 (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
|
|
|
+ 1703 level body once the unit's declarations are complete. Inlined at
|
|
|
+ 1704 both call sites because a stand-alone epsilon production is
|
|
|
+ 1705 "unreachable" to Coco/R (referenced only from actions). *)
|
|
|
+ 1706 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1707 = (. astSeq := AST.NoNode;
|
|
|
+ 1708 astTail := AST.NoNode; .)
|
|
|
+ 1709 Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 1710 astSeq, astTail, astStmt); .)
|
|
|
+ 1711 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 1712 astSeq, astTail, astStmt); .) ] }
|
|
|
+ 1713 (. astStmt := astSeq; .) .
|
|
|
+ 1714 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
+ 1715 are accepted: the statement after ';' is optional. *)
|
|
|
+ 1716 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
+ 1717 = (. astStmt := AST.NoNode; .)
|
|
|
+ 1718 ( AssOrCall
|
|
|
+ 1719 | IfStat
|
|
|
+ 1720 | WhileStat
|
|
|
+ 1721 | RepeatStat
|
|
|
+ 1722 | LoopStat
|
|
|
+ 1723 | ForStat
|
|
|
+ 1724 | CaseStat
|
|
|
+ 1725 | WithStat
|
|
|
+ 1726 | ReturnStat
|
|
|
+ 1727 | HaltStat
|
|
|
+ 1728 | NewStat
|
|
|
+ 1729 | DisposeStat
|
|
|
+ 1730 | IncDecStat
|
|
|
+ 1731 | InclExclStat
|
|
|
+ 1732 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
+ 1733 SemError(230) END;
|
|
|
+ 1734 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
+ 1735 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
+ 1736 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
+ 1737 AST.SetChild(astStmt, 0,
|
|
|
+ 1738 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
+ 1739 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
+ 1740 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
+ 1741 dk: INTEGER;
|
|
|
+ 1742 qd, qe: QbeGen.QVal;
|
|
|
+ 1743 qn: SymTab.Name;
|
|
|
+ 1744 sfx, isInc: BOOLEAN;
|
|
|
+ 1745 astNode, astD: AST.Node; .)
|
|
|
+ 1746 = ( "INCL" (. isInc := TRUE; .)
|
|
|
+ 1747 | "EXCL" (. isInc := FALSE; .) )
|
|
|
+ 1748 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
+ 1749 Expr<et2, qe> ")"
|
|
|
+ 1750 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1751 IF isInc THEN
|
|
|
+ 1752 AST.SetChild(astNode, 0,
|
|
|
+ 1753 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
+ 1754 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 1755 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
+ 1756 END;
|
|
|
+ 1757 IF astD # AST.NoNode THEN
|
|
|
+ 1758 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1759 IF astCur # AST.NoNode THEN
|
|
|
+ 1760 AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 1761 astStmt := astNode; .)
|
|
|
+ 1762 (. IF (at # SymTab.InvalidType)
|
|
|
+ 1763 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
+ 1764 SemError(222)
|
|
|
+ 1765 END; .) .
|
|
|
+ 1766 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
+ 1767 integer designator. *)
|
|
|
+ 1768 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
+ 1769 dk: INTEGER;
|
|
|
+ 1770 qd, qv, qn2, qstep:
|
|
|
+ 1771 QbeGen.QVal;
|
|
|
+ 1772 qn: SymTab.Name;
|
|
|
+ 1773 sfx, isInc: BOOLEAN;
|
|
|
+ 1774 astNode, astD, astStep:
|
|
|
+ 1775 AST.Node; .)
|
|
|
+ 1776 = (. isInc := TRUE; .)
|
|
|
+ 1777 ( "INC" (. isInc := TRUE; .)
|
|
|
+ 1778 | "DEC" (. isInc := FALSE; .) )
|
|
|
+ 1779 "(" (. astStep := AST.NoNode; .)
|
|
|
+ 1780 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
+ 1781 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
+ 1782 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1783 IF isInc THEN
|
|
|
+ 1784 AST.SetChild(astNode, 0,
|
|
|
+ 1785 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
+ 1786 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 1787 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
+ 1788 END;
|
|
|
+ 1789 IF astD # AST.NoNode THEN
|
|
|
+ 1790 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1791 IF astStep # AST.NoNode THEN
|
|
|
+ 1792 AST.SetChild(astNode, 2, astStep) END;
|
|
|
+ 1793 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 1794 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 1795 AND (dk # SymTab.KindParam)
|
|
|
+ 1796 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1797 SemError(210)
|
|
|
+ 1798 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
+ 1799 SemError(211)
|
|
|
+ 1800 END; .) .
|
|
|
+ 1801 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
+ 1802 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
+ 1803 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
+ 1804 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 1805 dk: INTEGER;
|
|
|
+ 1806 qd, qm: QbeGen.QVal;
|
|
|
+ 1807 qn: SymTab.Name;
|
|
|
+ 1808 sfx: BOOLEAN;
|
|
|
+ 1809 bt: SymTab.TypeIndex;
|
|
|
+ 1810 astNode, astD: AST.Node; .)
|
|
|
+ 1811 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 1812 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1813 AST.SetChild(astNode, 0,
|
|
|
+ 1814 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
+ 1815 IF astD # AST.NoNode THEN
|
|
|
+ 1816 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1817 astStmt := astNode; .)
|
|
|
+ 1818 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 1819 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 1820 AND (dk # SymTab.KindParam)
|
|
|
+ 1821 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1822 SemError(210)
|
|
|
+ 1823 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 1824 SymTab.ClPtr THEN
|
|
|
+ 1825 SemError(219)
|
|
|
+ 1826 END; .) .
|
|
|
+ 1827 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 1828 dk: INTEGER;
|
|
|
+ 1829 qd, qv: QbeGen.QVal;
|
|
|
+ 1830 qn: SymTab.Name;
|
|
|
+ 1831 sfx: BOOLEAN;
|
|
|
+ 1832 astNode, astD: AST.Node; .)
|
|
|
+ 1833 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 1834 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1835 AST.SetChild(astNode, 0,
|
|
|
+ 1836 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
+ 1837 IF astD # AST.NoNode THEN
|
|
|
+ 1838 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1839 astStmt := astNode; .)
|
|
|
+ 1840 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 1841 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 1842 AND (dk # SymTab.KindParam)
|
|
|
+ 1843 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1844 SemError(210)
|
|
|
+ 1845 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 1846 SymTab.ClPtr THEN
|
|
|
+ 1847 SemError(219)
|
|
|
+ 1848 END; .) .
|
|
|
+ 1849 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
+ 1850 address; field designators resolve through both stacks. *)
|
|
|
+ 1851 WithStat (. VAR nW: CARDINAL;
|
|
|
+ 1852 astNode: AST.Node; .)
|
|
|
+ 1853 = "WITH" (. nW := 0;
|
|
|
+ 1854 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
+ 1855 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
+ 1856 "DO" (. astStmt := AST.NoNode; .)
|
|
|
+ 1857 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
+ 1858 AST.NChild(astNode), astStmt);
|
|
|
+ 1859 astStmt := astNode;
|
|
|
+ 1860 WHILE nW > 0 DO
|
|
|
+ 1861 SymTab.PopScope;
|
|
|
+ 1862 QbeGen.PopWith;
|
|
|
+ 1863 DEC(nW)
|
|
|
+ 1864 END; .) .
|
|
|
+ 1865 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
+ 1866 (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 1867 dk: INTEGER;
|
|
|
+ 1868 qd, qe: QbeGen.QVal;
|
|
|
+ 1869 qn: SymTab.Name;
|
|
|
+ 1870 sfx: BOOLEAN; .)
|
|
|
+ 1871 = Design<dt, dk, qd, qn, sfx>
|
|
|
+ 1872 (. IF astCur # AST.NoNode THEN
|
|
|
+ 1873 AST.SetChild(wnode,
|
|
|
+ 1874 AST.NChild(wnode), astCur) END;
|
|
|
+ 1875 IF dt = SymTab.InvalidType THEN
|
|
|
+ 1876 ELSIF (SymTab.ClassOf(dt) #
|
|
|
+ 1877 SymTab.ClRecord)
|
|
|
+ 1878 AND (SymTab.ClassOf(dt) #
|
|
|
+ 1879 SymTab.ClClass) THEN
|
|
|
+ 1880 SemError(215)
|
|
|
+ 1881 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
+ 1882 QbeGen.PushWith(qd);
|
|
|
+ 1883 INC(nW)
|
|
|
+ 1884 END; .) .
|
|
|
+ 1885 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
+ 1886 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
+ 1887 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
+ 1888 dk: INTEGER;
|
|
|
+ 1889 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
+ 1890 qn: SymTab.Name;
|
|
|
+ 1891 ct2, res0: SymTab.TypeIndex;
|
|
|
+ 1892 q2, mg0: QbeGen.QVal;
|
|
|
+ 1893 isR, conv, wconv: BOOLEAN;
|
|
|
+ 1894 called, sfx: BOOLEAN;
|
|
|
+ 1895 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
+ 1896 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
+ 1897 = GetIdent<n>
|
|
|
+ 1898 ( ":" (. NoteLabel(n);
|
|
|
+ 1899 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
+ 1900 AST.SetChild(astNode, 0,
|
|
|
+ 1901 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1902 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
+ 1903 AST.SetChild(astLab, 0, astNode); .)
|
|
|
+ 1904 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
+ 1905 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
+ 1906 astStmt := astLab; .)
|
|
|
+ 1907 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
+ 1908 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
+ 1909 ( ":="
|
|
|
+ 1910 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 1911 AST.NkAssign, 0, astLhs, astCur);
|
|
|
+ 1912 IF (dt # SymTab.InvalidType)
|
|
|
+ 1913 AND (dk # SymTab.KindVar)
|
|
|
+ 1914 AND (dk # SymTab.KindParam)
|
|
|
+ 1915 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1916 SemError(210)
|
|
|
+ 1917 ELSIF NOT SymTab.Assignable(et,
|
|
|
+ 1918 dt) THEN
|
|
|
+ 1919 SemError(210)
|
|
|
+ 1920 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 1921 AND (SymTab.ClassOf(dt) =
|
|
|
+ 1922 SymTab.ClClass) THEN
|
|
|
+ 1923 SemError(230) END;
|
|
|
+ 1924 isR := (dt #
|
|
|
+ 1925 SymTab.InvalidType)
|
|
|
+ 1926 AND (SymTab.ClassOf(dt)
|
|
|
+ 1927 = SymTab.ClReal);
|
|
|
+ 1928 conv := isR
|
|
|
+ 1929 AND SymTab.IsIntFamily(et);
|
|
|
+ 1930 wconv := (dt #
|
|
|
+ 1931 SymTab.InvalidType)
|
|
|
+ 1932 AND SymTab.IsLongFamily(dt)
|
|
|
+ 1933 AND SymTab.IsIntFamily(et);
|
|
|
+ 1934 IF ((dk = SymTab.KindVar)
|
|
|
+ 1935 OR (dk = SymTab.KindParam)
|
|
|
+ 1936 OR (dk = SymTab.KindField))
|
|
|
+ 1937 AND (dt # SymTab.InvalidType)
|
|
|
+ 1938 AND (et # SymTab.InvalidType)
|
|
|
+ 1939 AND (SymTab.ClassOf(dt) #
|
|
|
+ 1940 SymTab.ClClass) THEN
|
|
|
+ 1941 END; .)
|
|
|
+ 1942 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
+ 1943 (. astRes := AstCallNode(astLhs);
|
|
|
+ 1944 sfx := FALSE; .)
|
|
|
+ 1945 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
+ 1946 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 1947 AST.NkAssign, 0, astRes, astCur);
|
|
|
+ 1948 IF NOT sfx THEN
|
|
|
+ 1949 SemError(233)
|
|
|
+ 1950 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
+ 1951 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
+ 1952 SemError(210)
|
|
|
+ 1953 END; .)
|
|
|
+ 1954 | (. IF ct2 #
|
|
|
+ 1955 SymTab.InvalidType THEN
|
|
|
+ 1956 SemError(233) END;
|
|
|
+ 1957 astStmt := astRes; .) )
|
|
|
+ 1958 | (* bare `P;`: proper parameterless
|
|
|
+ 1959 procedure call; anything else
|
|
|
+ 1960 here is 233 (was a bare syntax
|
|
|
+ 1961 error before 4.2) *)
|
|
|
+ 1962 (. astStmt := AstCallNode(astLhs);
|
|
|
+ 1963 IF (dk = SymTab.KindProc)
|
|
|
+ 1964 AND NOT sfx THEN
|
|
|
+ 1965 res0 := SymTab.ProcRes(qn);
|
|
|
+ 1966 IF res0 #
|
|
|
+ 1967 SymTab.InvalidType THEN
|
|
|
+ 1968 SemError(233)
|
|
|
+ 1969 ELSIF SymTab.ProcNPar(qn) #
|
|
|
+ 1970 0 THEN
|
|
|
+ 1971 SemError(233)
|
|
|
+ 1972 END
|
|
|
+ 1973 ELSE SemError(233)
|
|
|
+ 1974 END; .) ) ) .
|
|
|
+ 1975 (* Actual-parameter list shared by statement and expression calls.
|
|
|
+ 1976 want selects CallEnd's result handling; t/q carry the call
|
|
|
+ 1977 value (statement calls discard). Arity/type failures are 233;
|
|
|
+ 1978 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
+ 1979 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
+ 1980 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
+ 1981 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 1982 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
+ 1983 vs: INTEGER;
|
|
|
+ 1984 res: SymTab.TypeIndex;
|
|
|
+ 1985 mg: QbeGen.QVal;
|
|
|
+ 1986 ok, ind, isMeth, va: BOOLEAN; .)
|
|
|
+ 1987 = "(" (. called := TRUE;
|
|
|
+ 1988 ok := TRUE;
|
|
|
+ 1989 ind := FALSE;
|
|
|
+ 1990 isMeth := methCls #
|
|
|
+ 1991 SymTab.InvalidType;
|
|
|
+ 1992 IF isMeth THEN
|
|
|
+ 1993 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
+ 1994 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
+ 1995 res := SymTab.ProcRes(pn)
|
|
|
+ 1996 ELSIF (pt # SymTab.InvalidType)
|
|
|
+ 1997 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
+ 1998 ind := TRUE;
|
|
|
+ 1999 res := SymTab.ProcTypeRes(pt)
|
|
|
+ 2000 ELSE SemError(233);
|
|
|
+ 2001 ok := FALSE;
|
|
|
+ 2002 res := SymTab.InvalidType
|
|
|
+ 2003 END;
|
|
|
+ 2004 i := 0; .)
|
|
|
+ 2005 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
+ 2006 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
+ 2007 ")" (. IF ok THEN
|
|
|
+ 2008 IF isMeth THEN
|
|
|
+ 2009 np := SymTab.ClassMethodNPar(
|
|
|
+ 2010 methCls, pn)
|
|
|
+ 2011 ELSIF ind THEN
|
|
|
+ 2012 np := SymTab.ProcTypeNPar(pt)
|
|
|
+ 2013 ELSE np := SymTab.ProcNPar(pn)
|
|
|
+ 2014 END;
|
|
|
+ 2015 va := (NOT isMeth) AND (NOT ind)
|
|
|
+ 2016 AND (SymTab.SymKind(pn) =
|
|
|
+ 2017 SymTab.KindProc)
|
|
|
+ 2018 AND SymTab.Varargs(pn);
|
|
|
+ 2019 IF (i # np) AND NOT va THEN
|
|
|
+ 2020 SemError(233); ok := FALSE
|
|
|
+ 2021 END
|
|
|
+ 2022 END;
|
|
|
+ 2023 IF NOT ok THEN
|
|
|
+ 2024 t := SymTab.InvalidType;
|
|
|
+ 2025 QbeGen.CopyOp("0", q)
|
|
|
+ 2026 ELSIF want THEN
|
|
|
+ 2027 IF res =
|
|
|
+ 2028 SymTab.InvalidType THEN
|
|
|
+ 2029 IF NOT soft THEN SemError(233) END;
|
|
|
+ 2030 t := SymTab.InvalidType;
|
|
|
+ 2031 QbeGen.CopyOp("0", q)
|
|
|
+ 2032 ELSE t := res;
|
|
|
+ 2033 QbeGen.CopyOp("@", q)
|
|
|
+ 2034 END
|
|
|
+ 2035 ELSE
|
|
|
+ 2036 IF res #
|
|
|
+ 2037 SymTab.InvalidType THEN
|
|
|
+ 2038 SemError(233)
|
|
|
+ 2039 END;
|
|
|
+ 2040 t := SymTab.InvalidType;
|
|
|
+ 2041 QbeGen.CopyOp("0", q);
|
|
|
+ 2042 END; .) .
|
|
|
+ 2043 (* One actual: VAR formals take recorded designator addresses
|
|
|
+ 2044 (233 otherwise); value formals take converted expressions. *)
|
|
|
+ 2045 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
+ 2046 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
+ 2047 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
+ 2048 qe, qa, qt: QbeGen.QVal;
|
|
|
+ 2049 isV, conv, va: BOOLEAN;
|
|
|
+ 2050 cl: CHAR;
|
|
|
+ 2051 savedN, aj: CARDINAL;
|
|
|
+ 2052 savedArgs: ARRAY [0 .. 31]
|
|
|
+ 2053 OF AST.Node;
|
|
|
+ 2054 astActual: AST.Node; .)
|
|
|
+ 2055 = (. (* Parsing the actual can clobber
|
|
|
+ 2056 the enclosing call's argument
|
|
|
+ 2057 list (Factor resets astNArgs),
|
|
|
+ 2058 so save/restore it. *)
|
|
|
+ 2059 savedN := astNArgs; aj := 0;
|
|
|
+ 2060 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 2061 savedArgs[aj] := astArgs[aj];
|
|
|
+ 2062 INC(aj)
|
|
|
+ 2063 END; .)
|
|
|
+ 2064 Expr<at, qe> (. astActual := astCur;
|
|
|
+ 2065 astNArgs := savedN; aj := 0;
|
|
|
+ 2066 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 2067 astArgs[aj] := savedArgs[aj];
|
|
|
+ 2068 INC(aj)
|
|
|
+ 2069 END;
|
|
|
+ 2070 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
+ 2071 astArgs[astNArgs] := astCur;
|
|
|
+ 2072 INC(astNArgs)
|
|
|
2073 END;
|
|
|
- 2074 IF NOT ok THEN
|
|
|
- 2075 t := SymTab.InvalidType;
|
|
|
- 2076 QbeGen.CopyOp("0", q)
|
|
|
- 2077 ELSIF want THEN
|
|
|
- 2078 IF res =
|
|
|
- 2079 SymTab.InvalidType THEN
|
|
|
- 2080 IF NOT soft THEN SemError(233) END;
|
|
|
- 2081 t := SymTab.InvalidType;
|
|
|
- 2082 QbeGen.CopyOp("0", q)
|
|
|
- 2083 ELSE t := res;
|
|
|
- 2084 QbeGen.CopyOp("@", q)
|
|
|
- 2085 END
|
|
|
- 2086 ELSE
|
|
|
- 2087 IF res #
|
|
|
- 2088 SymTab.InvalidType THEN
|
|
|
- 2089 SemError(233)
|
|
|
- 2090 END;
|
|
|
- 2091 t := SymTab.InvalidType;
|
|
|
- 2092 QbeGen.CopyOp("0", q);
|
|
|
- 2093 END; .) .
|
|
|
- 2094 (* One actual: VAR formals take recorded designator addresses
|
|
|
- 2095 (233 otherwise); value formals take converted expressions. *)
|
|
|
- 2096 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
- 2097 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
- 2098 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
- 2099 qe, qa, qt: QbeGen.QVal;
|
|
|
- 2100 isV, conv, va: BOOLEAN;
|
|
|
- 2101 cl: CHAR;
|
|
|
- 2102 savedN, aj: CARDINAL;
|
|
|
- 2103 savedArgs: ARRAY [0 .. 31]
|
|
|
- 2104 OF AST.Node;
|
|
|
- 2105 astActual: AST.Node; .)
|
|
|
- 2106 = (. (* Parsing the actual can clobber
|
|
|
- 2107 the enclosing call's argument
|
|
|
- 2108 list (Factor resets astNArgs),
|
|
|
- 2109 so save/restore it. *)
|
|
|
- 2110 savedN := astNArgs; aj := 0;
|
|
|
- 2111 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 2112 savedArgs[aj] := astArgs[aj];
|
|
|
- 2113 INC(aj)
|
|
|
- 2114 END; .)
|
|
|
- 2115 Expr<at, qe> (. astActual := astCur;
|
|
|
- 2116 astNArgs := savedN; aj := 0;
|
|
|
- 2117 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 2118 astArgs[aj] := savedArgs[aj];
|
|
|
- 2119 INC(aj)
|
|
|
- 2120 END;
|
|
|
- 2121 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
- 2122 astArgs[astNArgs] := astCur;
|
|
|
- 2123 INC(astNArgs)
|
|
|
- 2124 END;
|
|
|
- 2125 va := (NOT ind)
|
|
|
- 2126 AND (methCls =
|
|
|
- 2127 SymTab.InvalidType)
|
|
|
- 2128 AND (SymTab.SymKind(pn) =
|
|
|
- 2129 SymTab.KindProc)
|
|
|
- 2130 AND SymTab.Varargs(pn);
|
|
|
- 2131 IF ind THEN
|
|
|
- 2132 ft :=
|
|
|
- 2133 SymTab.ProcTypeParamType(pt,
|
|
|
- 2134 i);
|
|
|
- 2135 isV :=
|
|
|
- 2136 SymTab.ProcTypeParamIsVar(pt,
|
|
|
- 2137 i)
|
|
|
- 2138 ELSIF methCls #
|
|
|
- 2139 SymTab.InvalidType THEN
|
|
|
- 2140 ft :=
|
|
|
- 2141 SymTab.ClassMethodParamType(
|
|
|
- 2142 methCls, pn, i);
|
|
|
- 2143 isV :=
|
|
|
- 2144 SymTab.ClassMethodParamIsVar(
|
|
|
- 2145 methCls, pn, i)
|
|
|
- 2146 ELSE
|
|
|
- 2147 ft := SymTab.ParamType(pn, i);
|
|
|
- 2148 isV := SymTab.ParamIsVar(pn, i)
|
|
|
- 2149 END;
|
|
|
- 2150 IF (at = SymTab.InvalidType) THEN
|
|
|
- 2151 ELSIF ft = SymTab.InvalidType THEN
|
|
|
- 2152 ELSIF isV THEN
|
|
|
- 2153 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 2154 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 2155 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 2156 AND QbeGen.IsImm(qe) THEN
|
|
|
- 2157 ELSIF (AST.Kind(astActual) #
|
|
|
- 2158 AST.NkDesignator)
|
|
|
- 2159 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
- 2160 SemError(233)
|
|
|
- 2161 ELSIF NOT SymTab.VarParamOk(at, ft) THEN
|
|
|
- 2162 SemError(233)
|
|
|
- 2163 END
|
|
|
- 2164 ELSE
|
|
|
- 2165 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 2166 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 2167 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 2168 AND QbeGen.IsImm(qe) THEN
|
|
|
- 2169 ELSIF NOT SymTab.Assignable(at, ft) THEN
|
|
|
- 2170 SemError(233)
|
|
|
- 2171 END
|
|
|
- 2172 END; .) .
|
|
|
- 2173 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2174 q: QbeGen.QVal;
|
|
|
- 2175 hasElse: BOOLEAN;
|
|
|
- 2176 astCond, astIf, astLast,
|
|
|
- 2177 astNode: AST.Node; .)
|
|
|
- 2178 = "IF" (. hasElse := FALSE; .)
|
|
|
- 2179 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 2180 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2181 SemError(214) END; .)
|
|
|
- 2182 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 2183 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2184 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2185 astIf := astNode;
|
|
|
- 2186 astLast := astNode; .)
|
|
|
- 2187 { "ELSIF"
|
|
|
- 2188 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 2189 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2190 SemError(214) END; .)
|
|
|
- 2191 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 2192 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2193 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2194 AST.SetChild(astLast, 2, astNode);
|
|
|
- 2195 astLast := astNode; .) }
|
|
|
- 2196 [ "ELSE" (. hasElse := TRUE;
|
|
|
- 2197 astStmt := AST.NoNode; .)
|
|
|
- 2198 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
- 2199 "END" (. astStmt := astIf; .) .
|
|
|
- 2200 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2201 q: QbeGen.QVal;
|
|
|
- 2202 astCond, astNode: AST.Node; .)
|
|
|
- 2203 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
- 2204 Expr<t, q> (. astCond := astCur;
|
|
|
- 2205 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2206 SemError(214) END; .)
|
|
|
- 2207 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
- 2208 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2209 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2210 astStmt := astNode; .)
|
|
|
- 2211 "END" .
|
|
|
- 2212 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2213 q: QbeGen.QVal;
|
|
|
- 2214 astCond, astBody, astNode:
|
|
|
- 2215 AST.Node; .)
|
|
|
- 2216 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
- 2217 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
- 2218 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
- 2219 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
- 2220 AST.SetChild(astNode, 0, astBody);
|
|
|
- 2221 AST.SetChild(astNode, 1, astCond);
|
|
|
- 2222 astStmt := astNode;
|
|
|
- 2223 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2224 SemError(214) END; .) .
|
|
|
- 2225 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
- 2226 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
- 2227 QbeGen.NewLabel(lEnd);
|
|
|
- 2228 QbeGen.PushLoop(lEnd); .)
|
|
|
- 2229 [ StatSeq ]
|
|
|
- 2230 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
- 2231 AST.SetChild(astNode, 0, astStmt);
|
|
|
- 2232 astStmt := astNode;
|
|
|
- 2233 QbeGen.PopLoop; .) .
|
|
|
- 2234 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
- 2235 Runtime direction would need a compare-select; the literal
|
|
|
- 2236 sign picks cslew/csegew at "DO" time. *)
|
|
|
- 2237 ForStat (. VAR lv: SymTab.Name;
|
|
|
- 2238 tlo, thi, tby:
|
|
|
- 2239 SymTab.TypeIndex;
|
|
|
- 2240 qlo, qhi, qby, qt, qk, qb:
|
|
|
- 2241 QbeGen.QVal;
|
|
|
- 2242 lTop, lBody, lEnd:
|
|
|
- 2243 QbeGen.QVal;
|
|
|
- 2244 by: INTEGER;
|
|
|
- 2245 ok: BOOLEAN;
|
|
|
- 2246 astVar, astLo, astHi, astBy,
|
|
|
- 2247 astNode: AST.Node; .)
|
|
|
- 2248 = "FOR" (. by := 1; .)
|
|
|
- 2249 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
- 2250 astStmt := AST.NoNode;
|
|
|
- 2251 astBy := AST.NoNode;
|
|
|
- 2252 ok := SymTab.Lookup(lv);
|
|
|
- 2253 IF NOT ok THEN
|
|
|
- 2254 SemError(201)
|
|
|
- 2255 ELSIF (SymTab.SymKind(lv) #
|
|
|
- 2256 SymTab.KindVar)
|
|
|
- 2257 AND (SymTab.SymKind(lv) #
|
|
|
- 2258 SymTab.KindParam) THEN
|
|
|
- 2259 SemError(220); ok := FALSE
|
|
|
- 2260 ELSIF NOT SymTab.IsIntFamily(
|
|
|
- 2261 SymTab.SymType(lv)) THEN
|
|
|
- 2262 SemError(220); ok := FALSE
|
|
|
- 2263 END; .)
|
|
|
- 2264 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
- 2265 IF NOT SymTab.IsIntFamily(tlo) THEN
|
|
|
- 2266 SemError(220); ok := FALSE
|
|
|
- 2267 END; .)
|
|
|
- 2268 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
- 2269 IF NOT SymTab.IsIntFamily(thi) THEN
|
|
|
- 2270 SemError(220); ok := FALSE
|
|
|
- 2271 END; .)
|
|
|
- 2272 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
- 2273 IF (tby #
|
|
|
- 2274 SymTab.InvalidType)
|
|
|
- 2275 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
- 2276 SemError(220); ok := FALSE
|
|
|
- 2277 END;
|
|
|
- 2278 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
- 2279 SemError(230); by := 1
|
|
|
- 2280 ELSIF by = 0 THEN
|
|
|
- 2281 SemError(220); by := 1
|
|
|
- 2282 END; .) ]
|
|
|
- 2283 "DO"
|
|
|
- 2284 [ StatSeq ]
|
|
|
- 2285 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
- 2286 AST.SetChild(astNode, 0, astVar);
|
|
|
- 2287 AST.SetChild(astNode, 1, astLo);
|
|
|
- 2288 AST.SetChild(astNode, 2, astHi);
|
|
|
- 2289 AST.SetChild(astNode, 3, astBy);
|
|
|
- 2290 AST.SetChild(astNode, 4, astStmt);
|
|
|
- 2291 astStmt := astNode;
|
|
|
- 2292 .) .
|
|
|
- 2293 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
- 2294 qsel, lEnd: QbeGen.QVal;
|
|
|
- 2295 arm, astNode, astArms,
|
|
|
- 2296 astArmsTail: AST.Node; .)
|
|
|
- 2297 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
- 2298 AST.SetChild(astNode, 0, astCur);
|
|
|
- 2299 astArms := AST.NoNode;
|
|
|
- 2300 astArmsTail := AST.NoNode;
|
|
|
- 2301 .)
|
|
|
- 2302 "OF" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
- 2303 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
- 2304 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
- 2305 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
- 2306 AST.SetOp(arm, 1);
|
|
|
- 2307 AST.SetChild(arm, 0, astStmt);
|
|
|
- 2308 AstAppend(AST.NkBlock,
|
|
|
- 2309 astArms, astArmsTail, arm); .) ]
|
|
|
- 2310 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
- 2311 astStmt := astNode;
|
|
|
- 2312 .) .
|
|
|
- 2313 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
- 2314 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
- 2315 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
- 2316 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
- 2317 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2318 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
- 2319 (. VAR arm: AST.Node; .)
|
|
|
- 2320 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
- 2321 CaseLabel<tsel, qsel, arm>
|
|
|
- 2322 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
- 2323 ":" (. astStmt := AST.NoNode; .)
|
|
|
- 2324 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
- 2325 astStmt);
|
|
|
- 2326 AstAppend(AST.NkBlock,
|
|
|
- 2327 arms, armsTail, arm);
|
|
|
- 2328 .) .
|
|
|
- 2329 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2330 arm: AST.Node>
|
|
|
- 2331 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
- 2332 q2, q3, qc, qd, qe:
|
|
|
- 2333 QbeGen.QVal;
|
|
|
- 2334 astLab: AST.Node;
|
|
|
- 2335 lNext: QbeGen.QVal; .)
|
|
|
- 2336 = Expr<t2, q2> (. astLab := astCur;
|
|
|
- 2337 IF (t2 #
|
|
|
- 2338 SymTab.InvalidType)
|
|
|
- 2339 AND (tsel #
|
|
|
- 2340 SymTab.InvalidType)
|
|
|
- 2341 AND ((SymTab.ClassOf(t2) =
|
|
|
- 2342 SymTab.ClSet)
|
|
|
- 2343 OR (SymTab.ClassOf(tsel) =
|
|
|
- 2344 SymTab.ClSet)) THEN
|
|
|
- 2345 SemError(230)
|
|
|
- 2346 ELSIF (t2 #
|
|
|
- 2347 SymTab.InvalidType)
|
|
|
- 2348 AND (tsel #
|
|
|
- 2349 SymTab.InvalidType)
|
|
|
- 2350 AND NOT SymTab.EqCheck(t2,
|
|
|
- 2351 tsel) THEN
|
|
|
- 2352 SemError(213) END;
|
|
|
- 2353 IF NOT QbeGen.IsImm(q2) THEN
|
|
|
- 2354 SemError(230)
|
|
|
- 2355 END; .)
|
|
|
- 2356 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
- 2357 AST.NkSubrange, 0, astLab, astCur);
|
|
|
- 2358 IF (t3 #
|
|
|
- 2359 SymTab.InvalidType)
|
|
|
- 2360 AND (tsel #
|
|
|
- 2361 SymTab.InvalidType)
|
|
|
- 2362 AND NOT SymTab.EqCheck(t3,
|
|
|
- 2363 tsel) THEN
|
|
|
- 2364 SemError(213) END;
|
|
|
- 2365 IF NOT QbeGen.IsImm(q3) THEN
|
|
|
- 2366 SemError(230)
|
|
|
- 2367 END; .) ]
|
|
|
- 2368 (. AST.SetChild(arm,
|
|
|
- 2369 AST.NChild(arm), astLab); .) .
|
|
|
- 2370 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2371 q, qt: QbeGen.QVal;
|
|
|
- 2372 res: SymTab.TypeIndex;
|
|
|
- 2373 hadE, conv: BOOLEAN;
|
|
|
- 2374 astVal, astNode: AST.Node; .)
|
|
|
- 2375 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
- 2376 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
- 2377 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
- 2378 IF hadE THEN
|
|
|
- 2379 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2380 END;
|
|
|
- 2381 astStmt := astNode;
|
|
|
- 2382 conv := FALSE;
|
|
|
- 2383 IF NOT SymTab.InProc() THEN
|
|
|
- 2384 SemError(232)
|
|
|
- 2385 ELSE res := SymTab.CurRes();
|
|
|
- 2386 IF NOT hadE THEN
|
|
|
- 2387 IF res #
|
|
|
- 2388 SymTab.InvalidType THEN
|
|
|
- 2389 SemError(232)
|
|
|
- 2390 END
|
|
|
- 2391 ELSIF (res =
|
|
|
- 2392 SymTab.InvalidType)
|
|
|
- 2393 OR (t #
|
|
|
- 2394 SymTab.InvalidType)
|
|
|
- 2395 AND NOT SymTab.Assignable(t,
|
|
|
- 2396 res) THEN
|
|
|
- 2397 SemError(232)
|
|
|
- 2398 END
|
|
|
- 2399 END; .) .
|
|
|
- 2400 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2401 q: QbeGen.QVal;
|
|
|
- 2402 astVal, astNode: AST.Node; .)
|
|
|
- 2403 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
- 2404 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
- 2405 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
- 2406 IF astVal # AST.NoNode THEN
|
|
|
- 2407 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2408 END;
|
|
|
- 2409 astStmt := astNode;
|
|
|
- 2410 .) .
|
|
|
- 2411 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
- 2412 Each index descends one level (bounds-checked, trap on breach);
|
|
|
- 2413 nested levels reload the inner descriptor address. q ends as the
|
|
|
- 2414 value (scalars), the descriptor address (plain arrays), or the
|
|
|
- 2415 element address (indexed); sfx marks the indexed form. *)
|
|
|
- 2416 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2417 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2418 (. VAR n: SymTab.Name; .)
|
|
|
- 2419 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
- 2420 (* The part of Design after the identifier: resolve it and walk the
|
|
|
- 2421 selectors. Split out so a statement can decide between a label
|
|
|
- 2422 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
- 2423 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2424 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2425 (. VAR fn, mal: SymTab.Name;
|
|
|
- 2426 cls: INTEGER;
|
|
|
- 2427 ic: SymTab.TypeIndex;
|
|
|
- 2428 curT, it, eT, bt:
|
|
|
- 2429 SymTab.TypeIndex;
|
|
|
- 2430 iq, ql, qlo, qhi, qe:
|
|
|
- 2431 QbeGen.QVal;
|
|
|
- 2432 lo, hi: INTEGER;
|
|
|
- 2433 fo: INTEGER;
|
|
|
- 2434 isOpen: BOOLEAN;
|
|
|
- 2435 qb, cv: QbeGen.QVal;
|
|
|
- 2436 fid, fref: INTEGER;
|
|
|
- 2437 r: BOOLEAN;
|
|
|
- 2438 astDes, astSel: AST.Node;
|
|
|
- 2439 fwd: BOOLEAN; .)
|
|
|
- 2440 = (. methCls := SymTab.InvalidType;
|
|
|
- 2441 QbeGen.CopyOp(n, qn);
|
|
|
- 2442 sfx := FALSE; fwd := FALSE;
|
|
|
- 2443 fid := 0; fref := 0;
|
|
|
- 2444 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 2445 (* a bare method name inside
|
|
|
- 2446 a CLASS IMPLEMENTATION
|
|
|
- 2447 is a sibling call on
|
|
|
- 2448 THIS *)
|
|
|
- 2449 ic := SymTab.CurImplClass();
|
|
|
- 2450 IF (ic #
|
|
|
- 2451 SymTab.InvalidType)
|
|
|
- 2452 AND SymTab.MethodExists(ic, n) THEN
|
|
|
- 2453 sfx := FALSE;
|
|
|
- 2454 QbeGen.CopyOp("@", q);
|
|
|
- 2455 methCls := ic;
|
|
|
- 2456 k := SymTab.KindProc;
|
|
|
- 2457 t := SymTab.InvalidType
|
|
|
- 2458 ELSIF SymTab.InProc() THEN
|
|
|
- 2459 (* not declared yet: a
|
|
|
- 2460 forward reference to a
|
|
|
- 2461 module-level variable
|
|
|
- 2462 declared further down. *)
|
|
|
- 2463 k := SymTab.KindVar;
|
|
|
- 2464 r := SymTab.FwdVarRef(n, k,
|
|
|
- 2465 fref, t);
|
|
|
- 2466 QbeGen.CopyOp("@", q);
|
|
|
- 2467 sfx := TRUE; fwd := TRUE
|
|
|
- 2468 ELSE
|
|
|
- 2469 SemError(201);
|
|
|
- 2470 t :=
|
|
|
- 2471 SymTab.InvalidType;
|
|
|
- 2472 k := -1;
|
|
|
- 2473 QbeGen.CopyOp("0", q)
|
|
|
- 2474 END
|
|
|
- 2475 ELSE
|
|
|
- 2476 t := SymTab.SymType(n);
|
|
|
- 2477 k := SymTab.SymKind(n);
|
|
|
- 2478 IF k = SymTab.KindConst THEN
|
|
|
- 2479 IF SymTab.Equal(n,
|
|
|
- 2480 "TRUE") THEN
|
|
|
- 2481 t := SymTab.BoolType();
|
|
|
- 2482 QbeGen.CopyOp("1", q)
|
|
|
- 2483 ELSIF SymTab.Equal(n,
|
|
|
- 2484 "FALSE") THEN
|
|
|
- 2485 t := SymTab.BoolType();
|
|
|
- 2486 QbeGen.CopyOp("0", q)
|
|
|
- 2487 ELSIF SymTab.Equal(n,
|
|
|
- 2488 "NIL") THEN
|
|
|
- 2489 QbeGen.CopyOp("0", q)
|
|
|
- 2490 ELSE
|
|
|
- 2491 cls :=
|
|
|
- 2492 SymTab.ClassOf(t);
|
|
|
- 2493 IF (t #
|
|
|
- 2494 SymTab.InvalidType)
|
|
|
- 2495 AND ((cls = SymTab.ClInt)
|
|
|
- 2496 OR (cls
|
|
|
- 2497 = SymTab.ClChar)
|
|
|
- 2498 OR (cls
|
|
|
- 2499 = SymTab.ClEnum)
|
|
|
- 2500 OR (cls
|
|
|
- 2501 = SymTab.ClReal)
|
|
|
- 2502 OR (cls
|
|
|
- 2503 = SymTab.ClLong)
|
|
|
- 2504 OR (cls
|
|
|
- 2505 = SymTab.ClNil)) THEN
|
|
|
- 2506 IF cls = SymTab.ClNil THEN
|
|
|
- 2507 QbeGen.CopyOp("0", q)
|
|
|
- 2508 ELSIF ((cls
|
|
|
- 2509 = SymTab.ClInt)
|
|
|
- 2510 OR (cls
|
|
|
- 2511 = SymTab.ClChar)
|
|
|
- 2512 OR (cls
|
|
|
- 2513 = SymTab.ClEnum)
|
|
|
- 2514 OR (cls
|
|
|
- 2515 = SymTab.ClLong))
|
|
|
- 2516 AND SymTab.GetSymVal(n, cv)
|
|
|
- 2517 AND QbeGen.IsImm(cv) THEN
|
|
|
- 2518 QbeGen.CopyOp(cv, q)
|
|
|
- 2519 ELSE
|
|
|
- 2520 QbeGen.LoadVar(n,
|
|
|
- 2521 cls = SymTab.ClReal,
|
|
|
- 2522 q)
|
|
|
- 2523 END
|
|
|
- 2524 ELSIF (cls = SymTab.ClArray)
|
|
|
- 2525 OR (cls = SymTab.ClRecord)
|
|
|
- 2526 OR (cls = SymTab.ClClass)
|
|
|
- 2527 OR (cls = SymTab.ClStr)
|
|
|
- 2528 OR (cls = SymTab.ClUStr) THEN
|
|
|
- 2529 (* aggregate constant:
|
|
|
- 2530 its value IS the
|
|
|
- 2531 descriptor address *)
|
|
|
- 2532 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
- 2533 QbeGen.CopyOp(cv, q)
|
|
|
- 2534 ELSE
|
|
|
- 2535 QbeGen.CopyOp("0", q)
|
|
|
- 2536 END
|
|
|
- 2537 ELSE
|
|
|
- 2538 IF t #
|
|
|
- 2539 SymTab.InvalidType THEN
|
|
|
- 2540 SemError(230)
|
|
|
- 2541 END;
|
|
|
- 2542 QbeGen.CopyOp("0", q)
|
|
|
- 2543 END
|
|
|
- 2544 END
|
|
|
- 2545 ELSIF (k = SymTab.KindVar)
|
|
|
- 2546 OR (k = SymTab.KindParam) THEN
|
|
|
- 2547 cls := SymTab.ClassOf(t);
|
|
|
- 2548 IF (cls # SymTab.ClInt)
|
|
|
- 2549 AND (cls # SymTab.ClBool)
|
|
|
- 2550 AND (cls # SymTab.ClChar)
|
|
|
- 2551 AND (cls # SymTab.ClUChar)
|
|
|
- 2552 AND (cls # SymTab.ClEnum)
|
|
|
- 2553 AND (cls # SymTab.ClReal)
|
|
|
- 2554 AND (cls # SymTab.ClPtr)
|
|
|
- 2555 AND (cls # SymTab.ClProc)
|
|
|
- 2556 AND (cls # SymTab.ClLong)
|
|
|
- 2557 AND (cls # SymTab.ClArray)
|
|
|
- 2558 AND (cls # SymTab.ClSet)
|
|
|
- 2559 AND (cls # SymTab.ClRecord)
|
|
|
- 2560 AND (cls # SymTab.ClUStr)
|
|
|
- 2561 AND (cls # SymTab.ClClass) THEN
|
|
|
- 2562 SemError(230);
|
|
|
- 2563 QbeGen.CopyOp("0", q)
|
|
|
- 2564 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 2565 END
|
|
|
- 2566 ELSE QbeGen.CopyOp("0", q);
|
|
|
- 2567 IF k = SymTab.KindImport THEN
|
|
|
- 2568 SemError(230)
|
|
|
- 2569 ELSIF k =
|
|
|
- 2570 SymTab.KindProc THEN
|
|
|
- 2571 (* bare procedure name:
|
|
|
- 2572 a following ArgList
|
|
|
- 2573 makes it a call;
|
|
|
- 2574 otherwise Fact
|
|
|
- 2575 reports 230 *)
|
|
|
- 2576 ELSE
|
|
|
- 2577 IF k = SymTab.KindField THEN
|
|
|
- 2578 IF QbeGen.TopWith(qb) THEN
|
|
|
- 2579 sfx := TRUE
|
|
|
- 2580 ELSE SemError(230);
|
|
|
- 2581 QbeGen.CopyOp("0", q)
|
|
|
- 2582 END
|
|
|
- 2583 END
|
|
|
- 2584 END
|
|
|
- 2585 END
|
|
|
- 2586 END; .)
|
|
|
- 2587 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
- 2588 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 2589 IF fwd THEN AST.SetOp(astDes, 1) END;
|
|
|
- 2590 IF fwd THEN Check.NoteForward(fref, astDes) END; .)
|
|
|
- 2591 { "[" Expr<it, iq>
|
|
|
- 2592 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 2593 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2594 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2595 SymTab.ClArray THEN
|
|
|
- 2596 SemError(217);
|
|
|
- 2597 t := SymTab.InvalidType
|
|
|
- 2598 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2599 AND (SymTab.ClassOf(it) #
|
|
|
- 2600 SymTab.ClChar)
|
|
|
- 2601 AND (SymTab.ClassOf(it) #
|
|
|
- 2602 SymTab.ClEnum) THEN
|
|
|
- 2603 SemError(218);
|
|
|
- 2604 t := SymTab.InvalidType
|
|
|
- 2605 ELSE
|
|
|
- 2606 eT := SymTab.ArrayElem(t);
|
|
|
- 2607 t := eT; sfx := TRUE
|
|
|
- 2608 END; .)
|
|
|
- 2609 { "," Expr<it, iq>
|
|
|
- 2610 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 2611 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2612 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2613 SymTab.ClArray THEN
|
|
|
- 2614 SemError(217);
|
|
|
- 2615 t := SymTab.InvalidType
|
|
|
- 2616 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2617 AND (SymTab.ClassOf(it) #
|
|
|
- 2618 SymTab.ClChar)
|
|
|
- 2619 AND (SymTab.ClassOf(it) #
|
|
|
- 2620 SymTab.ClEnum) THEN
|
|
|
- 2621 SemError(218);
|
|
|
- 2622 t := SymTab.InvalidType
|
|
|
- 2623 ELSE
|
|
|
- 2624 eT := SymTab.ArrayElem(t);
|
|
|
- 2625 t := eT; sfx := TRUE
|
|
|
- 2626 END; .) }
|
|
|
- 2627 "]"
|
|
|
- 2628 | "." GetIdent<fn>
|
|
|
+ 2074 va := (NOT ind)
|
|
|
+ 2075 AND (methCls =
|
|
|
+ 2076 SymTab.InvalidType)
|
|
|
+ 2077 AND (SymTab.SymKind(pn) =
|
|
|
+ 2078 SymTab.KindProc)
|
|
|
+ 2079 AND SymTab.Varargs(pn);
|
|
|
+ 2080 IF ind THEN
|
|
|
+ 2081 ft :=
|
|
|
+ 2082 SymTab.ProcTypeParamType(pt,
|
|
|
+ 2083 i);
|
|
|
+ 2084 isV :=
|
|
|
+ 2085 SymTab.ProcTypeParamIsVar(pt,
|
|
|
+ 2086 i)
|
|
|
+ 2087 ELSIF methCls #
|
|
|
+ 2088 SymTab.InvalidType THEN
|
|
|
+ 2089 ft :=
|
|
|
+ 2090 SymTab.ClassMethodParamType(
|
|
|
+ 2091 methCls, pn, i);
|
|
|
+ 2092 isV :=
|
|
|
+ 2093 SymTab.ClassMethodParamIsVar(
|
|
|
+ 2094 methCls, pn, i)
|
|
|
+ 2095 ELSE
|
|
|
+ 2096 ft := SymTab.ParamType(pn, i);
|
|
|
+ 2097 isV := SymTab.ParamIsVar(pn, i)
|
|
|
+ 2098 END;
|
|
|
+ 2099 IF (at = SymTab.InvalidType) THEN
|
|
|
+ 2100 ELSIF ft = SymTab.InvalidType THEN
|
|
|
+ 2101 ELSIF isV THEN
|
|
|
+ 2102 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 2103 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 2104 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 2105 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 2106 ELSIF (AST.Kind(astActual) #
|
|
|
+ 2107 AST.NkDesignator)
|
|
|
+ 2108 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
+ 2109 SemError(233)
|
|
|
+ 2110 ELSIF NOT SymTab.VarParamOk(at, ft) THEN
|
|
|
+ 2111 SemError(233)
|
|
|
+ 2112 END
|
|
|
+ 2113 ELSE
|
|
|
+ 2114 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 2115 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 2116 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 2117 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 2118 ELSIF NOT SymTab.Assignable(at, ft) THEN
|
|
|
+ 2119 SemError(233)
|
|
|
+ 2120 END
|
|
|
+ 2121 END; .) .
|
|
|
+ 2122 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2123 q: QbeGen.QVal;
|
|
|
+ 2124 hasElse: BOOLEAN;
|
|
|
+ 2125 astCond, astIf, astLast,
|
|
|
+ 2126 astNode: AST.Node; .)
|
|
|
+ 2127 = "IF" (. hasElse := FALSE; .)
|
|
|
+ 2128 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 2129 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2130 SemError(214) END; .)
|
|
|
+ 2131 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 2132 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2133 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2134 astIf := astNode;
|
|
|
+ 2135 astLast := astNode; .)
|
|
|
+ 2136 { "ELSIF"
|
|
|
+ 2137 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 2138 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2139 SemError(214) END; .)
|
|
|
+ 2140 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 2141 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2142 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2143 AST.SetChild(astLast, 2, astNode);
|
|
|
+ 2144 astLast := astNode; .) }
|
|
|
+ 2145 [ "ELSE" (. hasElse := TRUE;
|
|
|
+ 2146 astStmt := AST.NoNode; .)
|
|
|
+ 2147 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
+ 2148 "END" (. astStmt := astIf; .) .
|
|
|
+ 2149 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2150 q: QbeGen.QVal;
|
|
|
+ 2151 astCond, astNode: AST.Node; .)
|
|
|
+ 2152 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2153 Expr<t, q> (. astCond := astCur;
|
|
|
+ 2154 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2155 SemError(214) END; .)
|
|
|
+ 2156 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
+ 2157 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2158 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2159 astStmt := astNode; .)
|
|
|
+ 2160 "END" .
|
|
|
+ 2161 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2162 q: QbeGen.QVal;
|
|
|
+ 2163 astCond, astBody, astNode:
|
|
|
+ 2164 AST.Node; .)
|
|
|
+ 2165 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
+ 2166 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
+ 2167 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
+ 2168 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
+ 2169 AST.SetChild(astNode, 0, astBody);
|
|
|
+ 2170 AST.SetChild(astNode, 1, astCond);
|
|
|
+ 2171 astStmt := astNode;
|
|
|
+ 2172 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2173 SemError(214) END; .) .
|
|
|
+ 2174 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
+ 2175 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
+ 2176 QbeGen.NewLabel(lEnd);
|
|
|
+ 2177 QbeGen.PushLoop(lEnd); .)
|
|
|
+ 2178 [ StatSeq ]
|
|
|
+ 2179 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
+ 2180 AST.SetChild(astNode, 0, astStmt);
|
|
|
+ 2181 astStmt := astNode;
|
|
|
+ 2182 QbeGen.PopLoop; .) .
|
|
|
+ 2183 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
+ 2184 Runtime direction would need a compare-select; the literal
|
|
|
+ 2185 sign picks cslew/csegew at "DO" time. *)
|
|
|
+ 2186 ForStat (. VAR lv: SymTab.Name;
|
|
|
+ 2187 tlo, thi, tby:
|
|
|
+ 2188 SymTab.TypeIndex;
|
|
|
+ 2189 qlo, qhi, qby, qt, qk, qb:
|
|
|
+ 2190 QbeGen.QVal;
|
|
|
+ 2191 lTop, lBody, lEnd:
|
|
|
+ 2192 QbeGen.QVal;
|
|
|
+ 2193 by: INTEGER;
|
|
|
+ 2194 ok: BOOLEAN;
|
|
|
+ 2195 astVar, astLo, astHi, astBy,
|
|
|
+ 2196 astNode: AST.Node; .)
|
|
|
+ 2197 = "FOR" (. by := 1; .)
|
|
|
+ 2198 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
+ 2199 astStmt := AST.NoNode;
|
|
|
+ 2200 astBy := AST.NoNode;
|
|
|
+ 2201 ok := SymTab.Lookup(lv);
|
|
|
+ 2202 IF NOT ok THEN
|
|
|
+ 2203 SemError(201)
|
|
|
+ 2204 ELSIF (SymTab.SymKind(lv) #
|
|
|
+ 2205 SymTab.KindVar)
|
|
|
+ 2206 AND (SymTab.SymKind(lv) #
|
|
|
+ 2207 SymTab.KindParam) THEN
|
|
|
+ 2208 SemError(220); ok := FALSE
|
|
|
+ 2209 ELSIF NOT SymTab.IsIntFamily(
|
|
|
+ 2210 SymTab.SymType(lv)) THEN
|
|
|
+ 2211 SemError(220); ok := FALSE
|
|
|
+ 2212 END; .)
|
|
|
+ 2213 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
+ 2214 IF NOT SymTab.IsIntFamily(tlo) THEN
|
|
|
+ 2215 SemError(220); ok := FALSE
|
|
|
+ 2216 END; .)
|
|
|
+ 2217 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
+ 2218 IF NOT SymTab.IsIntFamily(thi) THEN
|
|
|
+ 2219 SemError(220); ok := FALSE
|
|
|
+ 2220 END; .)
|
|
|
+ 2221 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
+ 2222 IF (tby #
|
|
|
+ 2223 SymTab.InvalidType)
|
|
|
+ 2224 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
+ 2225 SemError(220); ok := FALSE
|
|
|
+ 2226 END;
|
|
|
+ 2227 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
+ 2228 SemError(230); by := 1
|
|
|
+ 2229 ELSIF by = 0 THEN
|
|
|
+ 2230 SemError(220); by := 1
|
|
|
+ 2231 END; .) ]
|
|
|
+ 2232 "DO"
|
|
|
+ 2233 [ StatSeq ]
|
|
|
+ 2234 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
+ 2235 AST.SetChild(astNode, 0, astVar);
|
|
|
+ 2236 AST.SetChild(astNode, 1, astLo);
|
|
|
+ 2237 AST.SetChild(astNode, 2, astHi);
|
|
|
+ 2238 AST.SetChild(astNode, 3, astBy);
|
|
|
+ 2239 AST.SetChild(astNode, 4, astStmt);
|
|
|
+ 2240 astStmt := astNode;
|
|
|
+ 2241 .) .
|
|
|
+ 2242 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
+ 2243 qsel, lEnd: QbeGen.QVal;
|
|
|
+ 2244 arm, astNode, astArms,
|
|
|
+ 2245 astArmsTail: AST.Node; .)
|
|
|
+ 2246 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
+ 2247 AST.SetChild(astNode, 0, astCur);
|
|
|
+ 2248 astArms := AST.NoNode;
|
|
|
+ 2249 astArmsTail := AST.NoNode;
|
|
|
+ 2250 .)
|
|
|
+ 2251 "OF" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
+ 2252 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
+ 2253 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2254 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
+ 2255 AST.SetOp(arm, 1);
|
|
|
+ 2256 AST.SetChild(arm, 0, astStmt);
|
|
|
+ 2257 AstAppend(AST.NkBlock,
|
|
|
+ 2258 astArms, astArmsTail, arm); .) ]
|
|
|
+ 2259 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
+ 2260 astStmt := astNode;
|
|
|
+ 2261 .) .
|
|
|
+ 2262 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
+ 2263 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
+ 2264 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
+ 2265 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
+ 2266 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2267 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
+ 2268 (. VAR arm: AST.Node; .)
|
|
|
+ 2269 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
+ 2270 CaseLabel<tsel, qsel, arm>
|
|
|
+ 2271 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
+ 2272 ":" (. astStmt := AST.NoNode; .)
|
|
|
+ 2273 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
+ 2274 astStmt);
|
|
|
+ 2275 AstAppend(AST.NkBlock,
|
|
|
+ 2276 arms, armsTail, arm);
|
|
|
+ 2277 .) .
|
|
|
+ 2278 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2279 arm: AST.Node>
|
|
|
+ 2280 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
+ 2281 q2, q3, qc, qd, qe:
|
|
|
+ 2282 QbeGen.QVal;
|
|
|
+ 2283 astLab: AST.Node;
|
|
|
+ 2284 lNext: QbeGen.QVal; .)
|
|
|
+ 2285 = Expr<t2, q2> (. astLab := astCur;
|
|
|
+ 2286 IF (t2 #
|
|
|
+ 2287 SymTab.InvalidType)
|
|
|
+ 2288 AND (tsel #
|
|
|
+ 2289 SymTab.InvalidType)
|
|
|
+ 2290 AND ((SymTab.ClassOf(t2) =
|
|
|
+ 2291 SymTab.ClSet)
|
|
|
+ 2292 OR (SymTab.ClassOf(tsel) =
|
|
|
+ 2293 SymTab.ClSet)) THEN
|
|
|
+ 2294 SemError(230)
|
|
|
+ 2295 ELSIF (t2 #
|
|
|
+ 2296 SymTab.InvalidType)
|
|
|
+ 2297 AND (tsel #
|
|
|
+ 2298 SymTab.InvalidType)
|
|
|
+ 2299 AND NOT SymTab.EqCheck(t2,
|
|
|
+ 2300 tsel) THEN
|
|
|
+ 2301 SemError(213) END;
|
|
|
+ 2302 IF NOT QbeGen.IsImm(q2) THEN
|
|
|
+ 2303 SemError(230)
|
|
|
+ 2304 END; .)
|
|
|
+ 2305 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
+ 2306 AST.NkSubrange, 0, astLab, astCur);
|
|
|
+ 2307 IF (t3 #
|
|
|
+ 2308 SymTab.InvalidType)
|
|
|
+ 2309 AND (tsel #
|
|
|
+ 2310 SymTab.InvalidType)
|
|
|
+ 2311 AND NOT SymTab.EqCheck(t3,
|
|
|
+ 2312 tsel) THEN
|
|
|
+ 2313 SemError(213) END;
|
|
|
+ 2314 IF NOT QbeGen.IsImm(q3) THEN
|
|
|
+ 2315 SemError(230)
|
|
|
+ 2316 END; .) ]
|
|
|
+ 2317 (. AST.SetChild(arm,
|
|
|
+ 2318 AST.NChild(arm), astLab); .) .
|
|
|
+ 2319 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2320 q, qt: QbeGen.QVal;
|
|
|
+ 2321 res: SymTab.TypeIndex;
|
|
|
+ 2322 hadE, conv: BOOLEAN;
|
|
|
+ 2323 astVal, astNode: AST.Node; .)
|
|
|
+ 2324 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
+ 2325 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
+ 2326 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
+ 2327 IF hadE THEN
|
|
|
+ 2328 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2329 END;
|
|
|
+ 2330 astStmt := astNode;
|
|
|
+ 2331 conv := FALSE;
|
|
|
+ 2332 IF NOT SymTab.InProc() THEN
|
|
|
+ 2333 SemError(232)
|
|
|
+ 2334 ELSE res := SymTab.CurRes();
|
|
|
+ 2335 IF NOT hadE THEN
|
|
|
+ 2336 IF res #
|
|
|
+ 2337 SymTab.InvalidType THEN
|
|
|
+ 2338 SemError(232)
|
|
|
+ 2339 END
|
|
|
+ 2340 ELSIF (res =
|
|
|
+ 2341 SymTab.InvalidType)
|
|
|
+ 2342 OR (t #
|
|
|
+ 2343 SymTab.InvalidType)
|
|
|
+ 2344 AND NOT SymTab.Assignable(t,
|
|
|
+ 2345 res) THEN
|
|
|
+ 2346 SemError(232)
|
|
|
+ 2347 END
|
|
|
+ 2348 END; .) .
|
|
|
+ 2349 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2350 q: QbeGen.QVal;
|
|
|
+ 2351 astVal, astNode: AST.Node; .)
|
|
|
+ 2352 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
+ 2353 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
+ 2354 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
+ 2355 IF astVal # AST.NoNode THEN
|
|
|
+ 2356 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2357 END;
|
|
|
+ 2358 astStmt := astNode;
|
|
|
+ 2359 .) .
|
|
|
+ 2360 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
+ 2361 Each index descends one level (bounds-checked, trap on breach);
|
|
|
+ 2362 nested levels reload the inner descriptor address. q ends as the
|
|
|
+ 2363 value (scalars), the descriptor address (plain arrays), or the
|
|
|
+ 2364 element address (indexed); sfx marks the indexed form. *)
|
|
|
+ 2365 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 2366 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 2367 (. VAR n: SymTab.Name; .)
|
|
|
+ 2368 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
+ 2369 (* The part of Design after the identifier: resolve it and walk the
|
|
|
+ 2370 selectors. Split out so a statement can decide between a label
|
|
|
+ 2371 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
+ 2372 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 2373 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 2374 (. VAR fn, mal: SymTab.Name;
|
|
|
+ 2375 cls: INTEGER;
|
|
|
+ 2376 ic: SymTab.TypeIndex;
|
|
|
+ 2377 curT, it, eT, bt:
|
|
|
+ 2378 SymTab.TypeIndex;
|
|
|
+ 2379 iq, ql, qlo, qhi, qe:
|
|
|
+ 2380 QbeGen.QVal;
|
|
|
+ 2381 lo, hi: INTEGER;
|
|
|
+ 2382 fo: INTEGER;
|
|
|
+ 2383 isOpen: BOOLEAN;
|
|
|
+ 2384 qb, cv: QbeGen.QVal;
|
|
|
+ 2385 fid, fref: INTEGER;
|
|
|
+ 2386 r: BOOLEAN;
|
|
|
+ 2387 astDes, astSel: AST.Node;
|
|
|
+ 2388 fwd: BOOLEAN; .)
|
|
|
+ 2389 = (. methCls := SymTab.InvalidType;
|
|
|
+ 2390 QbeGen.CopyOp(n, qn);
|
|
|
+ 2391 sfx := FALSE; fwd := FALSE;
|
|
|
+ 2392 fid := 0; fref := 0;
|
|
|
+ 2393 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 2394 (* a bare method name inside
|
|
|
+ 2395 a CLASS IMPLEMENTATION
|
|
|
+ 2396 is a sibling call on
|
|
|
+ 2397 THIS *)
|
|
|
+ 2398 ic := SymTab.CurImplClass();
|
|
|
+ 2399 IF (ic #
|
|
|
+ 2400 SymTab.InvalidType)
|
|
|
+ 2401 AND SymTab.MethodExists(ic, n) THEN
|
|
|
+ 2402 sfx := FALSE;
|
|
|
+ 2403 QbeGen.CopyOp("@", q);
|
|
|
+ 2404 methCls := ic;
|
|
|
+ 2405 k := SymTab.KindProc;
|
|
|
+ 2406 t := SymTab.InvalidType
|
|
|
+ 2407 ELSIF SymTab.InProc() THEN
|
|
|
+ 2408 (* not declared yet: a
|
|
|
+ 2409 forward reference to a
|
|
|
+ 2410 module-level variable
|
|
|
+ 2411 declared further down. *)
|
|
|
+ 2412 k := SymTab.KindVar;
|
|
|
+ 2413 r := SymTab.FwdVarRef(n, k,
|
|
|
+ 2414 fref, t);
|
|
|
+ 2415 QbeGen.CopyOp("@", q);
|
|
|
+ 2416 sfx := TRUE; fwd := TRUE
|
|
|
+ 2417 ELSE
|
|
|
+ 2418 SemError(201);
|
|
|
+ 2419 t :=
|
|
|
+ 2420 SymTab.InvalidType;
|
|
|
+ 2421 k := -1;
|
|
|
+ 2422 QbeGen.CopyOp("0", q)
|
|
|
+ 2423 END
|
|
|
+ 2424 ELSE
|
|
|
+ 2425 t := SymTab.SymType(n);
|
|
|
+ 2426 k := SymTab.SymKind(n);
|
|
|
+ 2427 IF k = SymTab.KindConst THEN
|
|
|
+ 2428 IF SymTab.Equal(n,
|
|
|
+ 2429 "TRUE") THEN
|
|
|
+ 2430 t := SymTab.BoolType();
|
|
|
+ 2431 QbeGen.CopyOp("1", q)
|
|
|
+ 2432 ELSIF SymTab.Equal(n,
|
|
|
+ 2433 "FALSE") THEN
|
|
|
+ 2434 t := SymTab.BoolType();
|
|
|
+ 2435 QbeGen.CopyOp("0", q)
|
|
|
+ 2436 ELSIF SymTab.Equal(n,
|
|
|
+ 2437 "NIL") THEN
|
|
|
+ 2438 QbeGen.CopyOp("0", q)
|
|
|
+ 2439 ELSE
|
|
|
+ 2440 cls :=
|
|
|
+ 2441 SymTab.ClassOf(t);
|
|
|
+ 2442 IF (t #
|
|
|
+ 2443 SymTab.InvalidType)
|
|
|
+ 2444 AND ((cls = SymTab.ClInt)
|
|
|
+ 2445 OR (cls
|
|
|
+ 2446 = SymTab.ClChar)
|
|
|
+ 2447 OR (cls
|
|
|
+ 2448 = SymTab.ClEnum)
|
|
|
+ 2449 OR (cls
|
|
|
+ 2450 = SymTab.ClReal)
|
|
|
+ 2451 OR (cls
|
|
|
+ 2452 = SymTab.ClLong)
|
|
|
+ 2453 OR (cls
|
|
|
+ 2454 = SymTab.ClNil)) THEN
|
|
|
+ 2455 IF cls = SymTab.ClNil THEN
|
|
|
+ 2456 QbeGen.CopyOp("0", q)
|
|
|
+ 2457 ELSIF ((cls
|
|
|
+ 2458 = SymTab.ClInt)
|
|
|
+ 2459 OR (cls
|
|
|
+ 2460 = SymTab.ClChar)
|
|
|
+ 2461 OR (cls
|
|
|
+ 2462 = SymTab.ClEnum)
|
|
|
+ 2463 OR (cls
|
|
|
+ 2464 = SymTab.ClLong))
|
|
|
+ 2465 AND SymTab.GetSymVal(n, cv)
|
|
|
+ 2466 AND QbeGen.IsImm(cv) THEN
|
|
|
+ 2467 QbeGen.CopyOp(cv, q)
|
|
|
+ 2468 ELSE
|
|
|
+ 2469 QbeGen.LoadVar(n,
|
|
|
+ 2470 cls = SymTab.ClReal,
|
|
|
+ 2471 q)
|
|
|
+ 2472 END
|
|
|
+ 2473 ELSIF (cls = SymTab.ClArray)
|
|
|
+ 2474 OR (cls = SymTab.ClRecord)
|
|
|
+ 2475 OR (cls = SymTab.ClClass)
|
|
|
+ 2476 OR (cls = SymTab.ClStr)
|
|
|
+ 2477 OR (cls = SymTab.ClUStr) THEN
|
|
|
+ 2478 (* aggregate constant:
|
|
|
+ 2479 its value IS the
|
|
|
+ 2480 descriptor address *)
|
|
|
+ 2481 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
+ 2482 QbeGen.CopyOp(cv, q)
|
|
|
+ 2483 ELSE
|
|
|
+ 2484 QbeGen.CopyOp("0", q)
|
|
|
+ 2485 END
|
|
|
+ 2486 ELSE
|
|
|
+ 2487 IF t #
|
|
|
+ 2488 SymTab.InvalidType THEN
|
|
|
+ 2489 SemError(230)
|
|
|
+ 2490 END;
|
|
|
+ 2491 QbeGen.CopyOp("0", q)
|
|
|
+ 2492 END
|
|
|
+ 2493 END
|
|
|
+ 2494 ELSIF (k = SymTab.KindVar)
|
|
|
+ 2495 OR (k = SymTab.KindParam) THEN
|
|
|
+ 2496 cls := SymTab.ClassOf(t);
|
|
|
+ 2497 IF (cls # SymTab.ClInt)
|
|
|
+ 2498 AND (cls # SymTab.ClBool)
|
|
|
+ 2499 AND (cls # SymTab.ClChar)
|
|
|
+ 2500 AND (cls # SymTab.ClUChar)
|
|
|
+ 2501 AND (cls # SymTab.ClEnum)
|
|
|
+ 2502 AND (cls # SymTab.ClReal)
|
|
|
+ 2503 AND (cls # SymTab.ClPtr)
|
|
|
+ 2504 AND (cls # SymTab.ClProc)
|
|
|
+ 2505 AND (cls # SymTab.ClLong)
|
|
|
+ 2506 AND (cls # SymTab.ClArray)
|
|
|
+ 2507 AND (cls # SymTab.ClSet)
|
|
|
+ 2508 AND (cls # SymTab.ClRecord)
|
|
|
+ 2509 AND (cls # SymTab.ClUStr)
|
|
|
+ 2510 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 2511 SemError(230);
|
|
|
+ 2512 QbeGen.CopyOp("0", q)
|
|
|
+ 2513 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 2514 END
|
|
|
+ 2515 ELSE QbeGen.CopyOp("0", q);
|
|
|
+ 2516 IF k = SymTab.KindImport THEN
|
|
|
+ 2517 SemError(230)
|
|
|
+ 2518 ELSIF k =
|
|
|
+ 2519 SymTab.KindProc THEN
|
|
|
+ 2520 (* bare procedure name:
|
|
|
+ 2521 a following ArgList
|
|
|
+ 2522 makes it a call;
|
|
|
+ 2523 otherwise Fact
|
|
|
+ 2524 reports 230 *)
|
|
|
+ 2525 ELSE
|
|
|
+ 2526 IF k = SymTab.KindField THEN
|
|
|
+ 2527 IF QbeGen.TopWith(qb) THEN
|
|
|
+ 2528 sfx := TRUE
|
|
|
+ 2529 ELSE SemError(230);
|
|
|
+ 2530 QbeGen.CopyOp("0", q)
|
|
|
+ 2531 END
|
|
|
+ 2532 END
|
|
|
+ 2533 END
|
|
|
+ 2534 END
|
|
|
+ 2535 END; .)
|
|
|
+ 2536 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
+ 2537 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 2538 IF fwd THEN AST.SetOp(astDes, 1) END;
|
|
|
+ 2539 IF fwd THEN Check.NoteForward(fref, astDes) END; .)
|
|
|
+ 2540 { "[" Expr<it, iq>
|
|
|
+ 2541 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 2542 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2543 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2544 SymTab.ClArray THEN
|
|
|
+ 2545 SemError(217);
|
|
|
+ 2546 t := SymTab.InvalidType
|
|
|
+ 2547 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 2548 AND (SymTab.ClassOf(it) #
|
|
|
+ 2549 SymTab.ClChar)
|
|
|
+ 2550 AND (SymTab.ClassOf(it) #
|
|
|
+ 2551 SymTab.ClEnum) THEN
|
|
|
+ 2552 SemError(218);
|
|
|
+ 2553 t := SymTab.InvalidType
|
|
|
+ 2554 ELSE
|
|
|
+ 2555 eT := SymTab.ArrayElem(t);
|
|
|
+ 2556 t := eT; sfx := TRUE
|
|
|
+ 2557 END; .)
|
|
|
+ 2558 { "," Expr<it, iq>
|
|
|
+ 2559 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 2560 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2561 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2562 SymTab.ClArray THEN
|
|
|
+ 2563 SemError(217);
|
|
|
+ 2564 t := SymTab.InvalidType
|
|
|
+ 2565 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 2566 AND (SymTab.ClassOf(it) #
|
|
|
+ 2567 SymTab.ClChar)
|
|
|
+ 2568 AND (SymTab.ClassOf(it) #
|
|
|
+ 2569 SymTab.ClEnum) THEN
|
|
|
+ 2570 SemError(218);
|
|
|
+ 2571 t := SymTab.InvalidType
|
|
|
+ 2572 ELSE
|
|
|
+ 2573 eT := SymTab.ArrayElem(t);
|
|
|
+ 2574 t := eT; sfx := TRUE
|
|
|
+ 2575 END; .) }
|
|
|
+ 2576 "]"
|
|
|
+ 2577 | "." GetIdent<fn>
|
|
|
+ 2578 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 2579 AST.SetOp(astSel, AST.SelField);
|
|
|
+ 2580 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
+ 2581 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
+ 2582 (* qualified L.x: materialize
|
|
|
+ 2583 the export, then load it *)
|
|
|
+ 2584 IF NOT SymTab.MaterializeAlias(n,
|
|
|
+ 2585 fn, mal) THEN
|
|
|
+ 2586 SemError(201);
|
|
|
+ 2587 t := SymTab.InvalidType;
|
|
|
+ 2588 QbeGen.CopyOp("0", q)
|
|
|
+ 2589 ELSE
|
|
|
+ 2590 QbeGen.CopyOp(mal, qn);
|
|
|
+ 2591 t := SymTab.SymType(mal);
|
|
|
+ 2592 k := SymTab.SymKind(mal);
|
|
|
+ 2593 sfx := FALSE;
|
|
|
+ 2594 IF k = SymTab.KindProc THEN
|
|
|
+ 2595 (* call: ArgList supplies
|
|
|
+ 2596 the value *)
|
|
|
+ 2597 QbeGen.CopyOp("0", q)
|
|
|
+ 2598 END
|
|
|
+ 2599 END
|
|
|
+ 2600 ELSIF t = SymTab.InvalidType THEN
|
|
|
+ 2601 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 2602 SymTab.ClRecord)
|
|
|
+ 2603 AND (SymTab.ClassOf(t) #
|
|
|
+ 2604 SymTab.ClClass) THEN
|
|
|
+ 2605 SemError(215);
|
|
|
+ 2606 t := SymTab.InvalidType
|
|
|
+ 2607 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 2608 SymTab.ClClass)
|
|
|
+ 2609 AND SymTab.MethodExists(t, fn) THEN
|
|
|
+ 2610 (* obj.Method: bind the
|
|
|
+ 2611 method and pass obj as
|
|
|
+ 2612 the hidden receiver; q
|
|
|
+ 2613 already holds the
|
|
|
+ 2614 object's address *)
|
|
|
+ 2615 QbeGen.CopyOp(fn, n);
|
|
|
+ 2616 QbeGen.CopyOp(fn, qn);
|
|
|
+ 2617 methCls := t;
|
|
|
+ 2618 k := SymTab.KindProc;
|
|
|
+ 2619 t := SymTab.InvalidType
|
|
|
+ 2620 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 2621 fn) THEN
|
|
|
+ 2622 SemError(216);
|
|
|
+ 2623 t := SymTab.InvalidType
|
|
|
+ 2624 ELSE
|
|
|
+ 2625 t := SymTab.FieldType(t, fn);
|
|
|
+ 2626 sfx := TRUE
|
|
|
+ 2627 END; .)
|
|
|
+ 2628 | "^"
|
|
|
2629 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 2630 AST.SetOp(astSel, AST.SelField);
|
|
|
- 2631 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
- 2632 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
- 2633 (* qualified L.x: materialize
|
|
|
- 2634 the export, then load it *)
|
|
|
- 2635 IF NOT SymTab.MaterializeAlias(n,
|
|
|
- 2636 fn, mal) THEN
|
|
|
- 2637 SemError(201);
|
|
|
- 2638 t := SymTab.InvalidType;
|
|
|
- 2639 QbeGen.CopyOp("0", q)
|
|
|
- 2640 ELSE
|
|
|
- 2641 QbeGen.CopyOp(mal, qn);
|
|
|
- 2642 t := SymTab.SymType(mal);
|
|
|
- 2643 k := SymTab.SymKind(mal);
|
|
|
- 2644 sfx := FALSE;
|
|
|
- 2645 IF k = SymTab.KindProc THEN
|
|
|
- 2646 (* call: ArgList supplies
|
|
|
- 2647 the value *)
|
|
|
- 2648 QbeGen.CopyOp("0", q)
|
|
|
- 2649 END
|
|
|
- 2650 END
|
|
|
- 2651 ELSIF t = SymTab.InvalidType THEN
|
|
|
- 2652 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 2653 SymTab.ClRecord)
|
|
|
- 2654 AND (SymTab.ClassOf(t) #
|
|
|
- 2655 SymTab.ClClass) THEN
|
|
|
- 2656 SemError(215);
|
|
|
- 2657 t := SymTab.InvalidType
|
|
|
- 2658 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 2659 SymTab.ClClass)
|
|
|
- 2660 AND SymTab.MethodExists(t, fn) THEN
|
|
|
- 2661 (* obj.Method: bind the
|
|
|
- 2662 method and pass obj as
|
|
|
- 2663 the hidden receiver; q
|
|
|
- 2664 already holds the
|
|
|
- 2665 object's address *)
|
|
|
- 2666 QbeGen.CopyOp(fn, n);
|
|
|
- 2667 QbeGen.CopyOp(fn, qn);
|
|
|
- 2668 methCls := t;
|
|
|
- 2669 k := SymTab.KindProc;
|
|
|
- 2670 t := SymTab.InvalidType
|
|
|
- 2671 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 2672 fn) THEN
|
|
|
- 2673 SemError(216);
|
|
|
- 2674 t := SymTab.InvalidType
|
|
|
- 2675 ELSE
|
|
|
- 2676 t := SymTab.FieldType(t, fn);
|
|
|
- 2677 sfx := TRUE
|
|
|
- 2678 END; .)
|
|
|
- 2679 | "^"
|
|
|
- 2680 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 2681 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 2682 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 2683 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2684 SymTab.ClPtr THEN
|
|
|
- 2685 SemError(219);
|
|
|
- 2686 t := SymTab.InvalidType
|
|
|
- 2687 ELSE
|
|
|
- 2688 bt := SymTab.PtrBase(t);
|
|
|
- 2689 IF bt = SymTab.InvalidType THEN
|
|
|
- 2690 ELSE
|
|
|
- 2691 t := bt;
|
|
|
- 2692 sfx := TRUE
|
|
|
- 2693 END
|
|
|
- 2694 END; .) } (. astCur := astDes; .) .
|
|
|
- 2695 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
- 2696 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
- 2697 (a value, or a descriptor address for aggregates); each component
|
|
|
- 2698 descends one level exactly like the Design components. *)
|
|
|
- 2699 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 2700 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
- 2701 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
- 2702 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
- 2703 iq, ql, qlo, qhi, qe, qb:
|
|
|
- 2704 QbeGen.QVal;
|
|
|
- 2705 lo, hi, fo: INTEGER;
|
|
|
- 2706 isOpen: BOOLEAN;
|
|
|
- 2707 fname: SymTab.Name;
|
|
|
- 2708 astWrap, astSel: AST.Node; .)
|
|
|
- 2709 = "[" Expr<it, iq>
|
|
|
- 2710 (. isM := FALSE;
|
|
|
- 2711 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 2712 astWrap := AST.MakeNode(
|
|
|
- 2713 AST.NkDesignator);
|
|
|
- 2714 AST.SetChild(astWrap, 0, node);
|
|
|
- 2715 node := astWrap
|
|
|
- 2716 END;
|
|
|
- 2717 AST.SetChild(node, AST.NChild(node),
|
|
|
- 2718 AST.MakeUn(AST.NkSelector,
|
|
|
- 2719 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2720 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2721 SymTab.ClArray THEN
|
|
|
- 2722 SemError(217);
|
|
|
- 2723 t := SymTab.InvalidType
|
|
|
- 2724 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2725 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
- 2726 AND (SymTab.ClassOf(it) # SymTab.ClEnum) THEN
|
|
|
- 2727 SemError(218);
|
|
|
- 2728 t := SymTab.InvalidType
|
|
|
- 2729 ELSE
|
|
|
- 2730 eT := SymTab.ArrayElem(t);
|
|
|
- 2731 t := eT; sfx := TRUE
|
|
|
- 2732 END; .)
|
|
|
- 2733 "]"
|
|
|
- 2734 | "." GetIdent<fname>
|
|
|
- 2735 (. isM := FALSE;
|
|
|
- 2736 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 2737 astWrap := AST.MakeNode(
|
|
|
- 2738 AST.NkDesignator);
|
|
|
- 2739 AST.SetChild(astWrap, 0, node);
|
|
|
- 2740 node := astWrap
|
|
|
- 2741 END;
|
|
|
- 2742 AST.SetChild(node, AST.NChild(node),
|
|
|
- 2743 AST.MakeUn(AST.NkSelector,
|
|
|
- 2744 AST.SelField,
|
|
|
- 2745 AST.MakeLeaf(AST.NkIdent,
|
|
|
- 2746 fname))); IF t = SymTab.InvalidType THEN
|
|
|
- 2747 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 2748 SymTab.ClRecord)
|
|
|
- 2749 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 2750 SemError(215);
|
|
|
- 2751 t := SymTab.InvalidType
|
|
|
- 2752 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 2753 SymTab.ClClass)
|
|
|
- 2754 AND SymTab.MethodExists(t, fname) THEN
|
|
|
- 2755 (* a method on the call result:
|
|
|
- 2756 a following ArgList makes
|
|
|
- 2757 the call *)
|
|
|
- 2758 mname := fname;
|
|
|
- 2759 methCls := t; isM := TRUE;
|
|
|
- 2760 t := SymTab.InvalidType
|
|
|
- 2761 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 2762 fname) THEN
|
|
|
- 2763 SemError(216);
|
|
|
- 2764 t := SymTab.InvalidType
|
|
|
- 2765 ELSE
|
|
|
- 2766 t := SymTab.FieldType(t, fname);
|
|
|
- 2767 sfx := TRUE
|
|
|
- 2768 END; .)
|
|
|
- 2769 | "^" (. isM := FALSE;
|
|
|
- 2770 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 2771 astWrap := AST.MakeNode(
|
|
|
- 2772 AST.NkDesignator);
|
|
|
- 2773 AST.SetChild(astWrap, 0, node);
|
|
|
- 2774 node := astWrap
|
|
|
- 2775 END;
|
|
|
- 2776 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 2777 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 2778 AST.SetChild(node,
|
|
|
- 2779 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 2780 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2781 SymTab.ClPtr THEN
|
|
|
- 2782 SemError(219);
|
|
|
- 2783 t := SymTab.InvalidType
|
|
|
- 2784 ELSE
|
|
|
- 2785 bt := SymTab.PtrBase(t);
|
|
|
- 2786 IF bt # SymTab.InvalidType THEN
|
|
|
- 2787 t := bt; sfx := TRUE
|
|
|
- 2788 END
|
|
|
- 2789 END; .) .
|
|
|
- 2790 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2791 (. VAR t2: SymTab.TypeIndex;
|
|
|
- 2792 op: INTEGER;
|
|
|
- 2793 q2, qt, wl: QbeGen.QVal;
|
|
|
- 2794 astA, astB: AST.Node;
|
|
|
- 2795 astOp: INTEGER;
|
|
|
- 2796 astMade: BOOLEAN;
|
|
|
- 2797 isR: BOOLEAN; .)
|
|
|
- 2798 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
- 2799 [ Rel<op> SimExpr<t2, q2>
|
|
|
- 2800 (. astB := astCur; astMade := TRUE;
|
|
|
- 2801 astOp := AST.OpEq;
|
|
|
- 2802 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
- 2803 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
- 2804 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
- 2805 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
- 2806 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
- 2807 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
- 2808 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
- 2809 END;
|
|
|
- 2810 IF op = SymTab.OpIn THEN
|
|
|
- 2811 IF SymTab.InCheck(t, t2) THEN
|
|
|
- 2812 IF (t = SymTab.InvalidType)
|
|
|
- 2813 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 2814 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 2815 ELSE
|
|
|
- 2816 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 2817 END
|
|
|
- 2818 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
- 2819 QbeGen.CopyOp("0", q)
|
|
|
- 2820 END
|
|
|
- 2821 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
- 2822 IF (t = SymTab.InvalidType)
|
|
|
- 2823 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 2824 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 2825 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
- 2826 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
- 2827 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
- 2828 AND (op # SymTab.OpNeq2) THEN
|
|
|
- 2829 SemError(213); t := SymTab.InvalidType;
|
|
|
- 2830 QbeGen.CopyOp("0", q)
|
|
|
- 2831 ELSE
|
|
|
- 2832 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 2833 END
|
|
|
- 2834 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 2835 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 2836 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 2837 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
- 2838 QbeGen.StrEq(op, q, q2, qt);
|
|
|
- 2839 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 2840 ELSIF SymTab.IsLongFamily(t)
|
|
|
- 2841 OR SymTab.IsLongFamily(t2) THEN
|
|
|
- 2842 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 2843 ELSE
|
|
|
- 2844 t := SymTab.BoolType();
|
|
|
- 2845 QbeGen.CopyOp("@", q)
|
|
|
- 2846 END
|
|
|
- 2847 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
- 2848 QbeGen.CopyOp("0", q)
|
|
|
- 2849 END;
|
|
|
- 2850 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
- 2851 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
- 2852 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 2853 Rel<VAR op: INTEGER>
|
|
|
- 2854 = "=" (. op := SymTab.OpEq; .)
|
|
|
- 2855 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
- 2856 | "<" (. op := SymTab.OpLt; .)
|
|
|
- 2857 | "<=" (. op := SymTab.OpLe; .)
|
|
|
- 2858 | ">" (. op := SymTab.OpGt; .)
|
|
|
- 2859 | ">=" (. op := SymTab.OpGe; .)
|
|
|
- 2860 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
- 2861 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2862 (. VAR t2, res2, lt, rt:
|
|
|
- 2863 SymTab.TypeIndex;
|
|
|
- 2864 op: INTEGER;
|
|
|
- 2865 q2, qt, wq, qf, q2a, q2b:
|
|
|
- 2866 QbeGen.QVal;
|
|
|
- 2867 neg, isR, isL, folded:
|
|
|
- 2868 BOOLEAN;
|
|
|
- 2869 fok: BOOLEAN;
|
|
|
- 2870 lw, rw, mw: CARDINAL;
|
|
|
- 2871 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 2872 astA, astB: AST.Node;
|
|
|
- 2873 astSign, astOp: INTEGER; .)
|
|
|
- 2874 = (. neg := FALSE; astSign := 0; .)
|
|
|
- 2875 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
- 2876 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
- 2877 Term<t, q> (. astA := astCur;
|
|
|
- 2878 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
- 2879 QbeGen.NegFold(q, q)
|
|
|
- 2880 END;
|
|
|
- 2881 IF astSign < 0 THEN
|
|
|
- 2882 astCur := AST.MakeUn(
|
|
|
- 2883 AST.NkUnary, AST.OpSub, astA);
|
|
|
- 2884 astA := astCur
|
|
|
- 2885 END; .)
|
|
|
- 2886 { AddOp<op>
|
|
|
- 2887 Term<t2, q2> (. astB := astCur; .)
|
|
|
- 2888 (. astOp := AST.OpAdd;
|
|
|
- 2889 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
- 2890 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
- 2891 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 2892 astCur := astA;
|
|
|
- 2893 IF op = SymTab.OpOr THEN
|
|
|
- 2894 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
- 2895 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 2896 t := SymTab.BoolType()
|
|
|
- 2897 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 2898 IF t # SymTab.InvalidType THEN
|
|
|
- 2899 QbeGen.CopyOp("@", q)
|
|
|
- 2900 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 2901 END
|
|
|
- 2902 ELSIF (op = SymTab.OpAdd)
|
|
|
- 2903 AND (SymTab.UStrCompat(t, t2)
|
|
|
- 2904 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 2905 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
- 2906 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
- 2907 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
- 2908 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 2909 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
- 2910 (* UString concatenation: a UCHAR operand becomes a
|
|
|
- 2911 1-codepoint UString; the result is a descriptor in the
|
|
|
- 2912 shim's concat buffer. Work on copies so neither
|
|
|
- 2913 operand is clobbered. *)
|
|
|
- 2914 t := SymTab.NewUStr();
|
|
|
- 2915 QbeGen.CopyOp("@", q)
|
|
|
- 2916 ELSIF (op = SymTab.OpAdd)
|
|
|
- 2917 AND (SymTab.StrCompat(t, t2)
|
|
|
- 2918 OR (SymTab.IsStrType(t)
|
|
|
- 2919 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
- 2920 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
- 2921 AND SymTab.IsStrType(t2))) THEN
|
|
|
- 2922 (* string concatenation; a CHAR operand becomes a
|
|
|
- 2923 1-character string literal. When both operands are
|
|
|
- 2924 constants, fold to a single string literal so a
|
|
|
- 2925 constructor element stays compile-time. *)
|
|
|
- 2926 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
- 2927 qt, fok);
|
|
|
- 2928 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
- 2929 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 2930 END;
|
|
|
- 2931 t := SymTab.NewStr()
|
|
|
- 2932 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 2933 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 2934 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 2935 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 2936 mw := lw;
|
|
|
- 2937 IF rw > mw THEN mw := rw END;
|
|
|
- 2938 t := SymTab.NewSet(
|
|
|
- 2939 SymTab.NewSubR(0,
|
|
|
- 2940 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 2941 QbeGen.CopyOp("@", q)
|
|
|
- 2942 ELSE
|
|
|
- 2943 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
- 2944 lt := t; rt := t2; t := res2
|
|
|
- 2945 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 2946 IF t # SymTab.InvalidType THEN
|
|
|
- 2947 isL := SymTab.IsLongFamily(t);
|
|
|
- 2948 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 2949 folded := FALSE;
|
|
|
- 2950 IF (NOT isL) AND (NOT isR)
|
|
|
- 2951 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 2952 IF op = SymTab.OpAdd THEN
|
|
|
- 2953 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
- 2954 ELSE
|
|
|
- 2955 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
- 2956 END
|
|
|
- 2957 END;
|
|
|
- 2958 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 2959 ELSE
|
|
|
- 2960 QbeGen.CopyOp("@", q)
|
|
|
- 2961 END
|
|
|
- 2962 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 2963 END
|
|
|
- 2964 END; .) }
|
|
|
- 2965 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 2966 AddOp<VAR op: INTEGER>
|
|
|
- 2967 = "+" (. op := SymTab.OpAdd; .)
|
|
|
- 2968 | "-" (. op := SymTab.OpSub; .)
|
|
|
- 2969 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
- 2970 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2971 (. VAR t2, res2, lt, rt:
|
|
|
- 2972 SymTab.TypeIndex;
|
|
|
- 2973 op: INTEGER;
|
|
|
- 2974 q2, qt, wq, qf:
|
|
|
- 2975 QbeGen.QVal;
|
|
|
- 2976 isR, isL, folded: BOOLEAN;
|
|
|
- 2977 lw, rw, mw: CARDINAL;
|
|
|
- 2978 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 2979 astA, astB: AST.Node;
|
|
|
- 2980 astOp: INTEGER; .)
|
|
|
- 2981 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
- 2982 Fact<t2, q2> (. astB := astCur; .)
|
|
|
- 2983 (. astOp := AST.OpMul;
|
|
|
- 2984 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
- 2985 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
- 2986 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
- 2987 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
- 2988 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 2989 astCur := astA;
|
|
|
- 2990 IF op = SymTab.OpAnd THEN
|
|
|
- 2991 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
- 2992 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 2993 t := SymTab.BoolType()
|
|
|
- 2994 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 2995 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
- 2996 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 2997 END
|
|
|
- 2998 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 2999 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3000 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3001 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 3002 mw := lw;
|
|
|
- 3003 IF rw > mw THEN mw := rw END;
|
|
|
- 3004 t := SymTab.NewSet(
|
|
|
- 3005 SymTab.NewSubR(0,
|
|
|
- 3006 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 3007 QbeGen.CopyOp("@", q)
|
|
|
- 3008 ELSE
|
|
|
- 3009 IF SymTab.ArithCheck(t, t2,
|
|
|
- 3010 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
- 3011 res2) THEN
|
|
|
- 3012 lt := t; rt := t2; t := res2
|
|
|
- 3013 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 3014 IF t # SymTab.InvalidType THEN
|
|
|
- 3015 isL := SymTab.IsLongFamily(t);
|
|
|
- 3016 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 3017 folded := FALSE;
|
|
|
- 3018 IF (NOT isL) AND (NOT isR)
|
|
|
- 3019 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 3020 IF op = SymTab.OpTimes THEN
|
|
|
- 3021 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
- 3022 ELSIF op = SymTab.OpDiv THEN
|
|
|
- 3023 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
- 3024 ELSIF op = SymTab.OpMod THEN
|
|
|
- 3025 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
- 3026 END
|
|
|
- 3027 END;
|
|
|
- 3028 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 3029 ELSE
|
|
|
- 3030 QbeGen.CopyOp("@", q)
|
|
|
- 3031 END
|
|
|
- 3032 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3033 END
|
|
|
- 3034 END; .) }
|
|
|
- 3035 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3036 MulOp<VAR op: INTEGER>
|
|
|
- 3037 = "*" (. op := SymTab.OpTimes; .)
|
|
|
- 3038 | "/" (. op := SymTab.OpSlash; .)
|
|
|
- 3039 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
- 3040 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
- 3041 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
- 3042 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3043 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
- 3044 et, dt, t2, st, ct2, et2:
|
|
|
- 3045 SymTab.TypeIndex;
|
|
|
- 3046 dk: INTEGER;
|
|
|
- 3047 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
- 3048 QbeGen.QVal;
|
|
|
- 3049 qn, vn: SymTab.Name;
|
|
|
- 3050 vt: SymTab.TypeIndex;
|
|
|
- 3051 c1, c2: INTEGER;
|
|
|
- 3052 lo, hi: INTEGER;
|
|
|
- 3053 isMax: BOOLEAN;
|
|
|
- 3054 called, isHigh, sfx, isCh,
|
|
|
- 3055 isU, uok, isStr: BOOLEAN;
|
|
|
- 3056 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
- 3057 astD: AST.Node;
|
|
|
- 3058 astCall: BOOLEAN;
|
|
|
- 3059 astNode, astNot: AST.Node;
|
|
|
- 3060 j: CARDINAL;
|
|
|
- 3061 astArg2: AST.Node;
|
|
|
- 3062 astBrace: AST.Node;
|
|
|
- 3063 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN; .)
|
|
|
- 3064 = (. astIsLit := FALSE; .)
|
|
|
- 3065 ( integer (. LexString(s);
|
|
|
- 3066 QbeGen.NormInt(s, q); IF twoPhase THEN astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s) END;
|
|
|
- 3067 t := SymTab.IntType(); .)
|
|
|
- 3068 | charConst (. LexString(s);
|
|
|
- 3069 QbeGen.NormLit(s, q, isCh);
|
|
|
- 3070 IF twoPhase THEN
|
|
|
- 3071 astIsLit := TRUE;
|
|
|
- 3072 astCur := AST.MakeLeaf(
|
|
|
- 3073 AST.NkCharLit, s)
|
|
|
- 3074 END;
|
|
|
- 3075 t := SymTab.CharType(); .)
|
|
|
- 3076 | real (. LexString(s);
|
|
|
- 3077 QbeGen.NormReal(s, q);
|
|
|
- 3078 IF twoPhase THEN
|
|
|
- 3079 astIsLit := TRUE;
|
|
|
- 3080 astCur := AST.MakeLeaf(
|
|
|
- 3081 AST.NkRealLit, s)
|
|
|
- 3082 END;
|
|
|
- 3083 t := SymTab.RealType(); .)
|
|
|
- 3084 | string (. LexString(s);
|
|
|
- 3085 IF twoPhase THEN
|
|
|
- 3086 astIsLit := TRUE;
|
|
|
- 3087 astCur := AST.MakeLeaf(
|
|
|
- 3088 AST.NkStrLit, s)
|
|
|
- 3089 END;
|
|
|
- 3090 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3091 t := SymTab.CharType();
|
|
|
- 3092 QbeGen.IntStr(
|
|
|
- 3093 QbeGen.CharVal(s), q)
|
|
|
- 3094 ELSE t := SymTab.NewStr();
|
|
|
- 3095 QbeGen.DeclStr(s, q);
|
|
|
- 3096 (* a literal's value IS its
|
|
|
- 3097 static descriptor address *)
|
|
|
- 3098 END; .)
|
|
|
- 3099 | ustring (. LexString(s);
|
|
|
- 3100 IF twoPhase THEN
|
|
|
- 3101 astIsLit := TRUE;
|
|
|
- 3102 astCur := AST.MakeLeaf(
|
|
|
- 3103 AST.NkStrLit, s)
|
|
|
- 3104 END;
|
|
|
- 3105 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
- 3106 uok);
|
|
|
- 3107 IF NOT uok THEN
|
|
|
- 3108 SemError(234);
|
|
|
- 3109 t := SymTab.InvalidType
|
|
|
- 3110 ELSIF isU THEN
|
|
|
- 3111 t := SymTab.UCharType();
|
|
|
- 3112 QbeGen.IntStr(ucp, q)
|
|
|
- 3113 ELSE
|
|
|
- 3114 t := SymTab.NewUStr();
|
|
|
- 3115 END; .)
|
|
|
- 3116 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
- 3117 astNArgs := 0; called := FALSE;
|
|
|
- 3118 t := dt;
|
|
|
- 3119 IF dk = SymTab.KindConst THEN
|
|
|
- 3120 QbeGen.CopyOp(qd, q)
|
|
|
- 3121 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3122 END; .)
|
|
|
- 3123 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
- 3124 astBrace := astCur; .) ]
|
|
|
- 3125 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 3126 (. astCall := TRUE;
|
|
|
- 3127 astNode := AstCallNode(astD);
|
|
|
- 3128 astRes := astNode;
|
|
|
- 3129 t := ct2;
|
|
|
- 3130 QbeGen.CopyOp(q2, q);
|
|
|
- 3131 sfx := FALSE; .)
|
|
|
- 3132 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
- 3133 [ (. astNArgs := 0; .)
|
|
|
- 3134 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 3135 (. astNode := AstCallNode(astRes);
|
|
|
- 3136 astRes := astNode;
|
|
|
- 3137 t := ct2;
|
|
|
- 3138 QbeGen.CopyOp(q2, q);
|
|
|
- 3139 sfx := FALSE; .) ] }
|
|
|
- 3140 (. IF sfx THEN
|
|
|
- 3141 IF t = SymTab.InvalidType THEN
|
|
|
- 3142 QbeGen.CopyOp("0", q)
|
|
|
- 3143 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3144 SymTab.ClRecord)
|
|
|
- 3145 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
- 3146 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
- 3147 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 3148 QbeGen.CopyOp("@", q)
|
|
|
- 3149 END
|
|
|
- 3150 END; .) ]
|
|
|
- 3151 (. IF called THEN
|
|
|
- 3152 astCur := astRes
|
|
|
- 3153 ELSIF astCall THEN
|
|
|
- 3154 astCur := astBrace
|
|
|
- 3155 ELSE astCur := astD
|
|
|
- 3156 END;
|
|
|
- 3157 astIsLit := TRUE;
|
|
|
- 3158 IF NOT called
|
|
|
- 3159 AND (dk = SymTab.KindProc) THEN
|
|
|
- 3160 (* bare zero-arg function
|
|
|
- 3161 call (parentheses may be
|
|
|
- 3162 omitted); a proper or
|
|
|
- 3163 parameterised proc here
|
|
|
- 3164 is 230 *)
|
|
|
- 3165 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
- 3166 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
- 3167 t := SymTab.ProcRes(qn);
|
|
|
- 3168 QbeGen.CopyOp("@", q);
|
|
|
- 3169 astCur := AST.MakeNode(AST.NkCall);
|
|
|
- 3170 AST.SetChild(astCur, 0, astD)
|
|
|
- 3171 ELSE
|
|
|
- 3172 t := SymTab.ProcTypeOf(qn);
|
|
|
- 3173 QbeGen.CopyOp("@", q)
|
|
|
- 3174 END
|
|
|
- 3175 END; .)
|
|
|
- 3176 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
- 3177 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
- 3178 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
- 3179 isU := FALSE; .)
|
|
|
- 3180 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3181 isStr := TRUE;
|
|
|
- 3182 isU := FALSE;
|
|
|
- 3183 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3184 dt := SymTab.CharType();
|
|
|
- 3185 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
- 3186 qd)
|
|
|
- 3187 ELSE
|
|
|
- 3188 dt := SymTab.NewStr();
|
|
|
- 3189 QbeGen.DeclStr(s, qd);
|
|
|
- 3190 END;
|
|
|
- 3191 dk := -1;
|
|
|
- 3192 qn[0] := CHR(0); .)
|
|
|
- 3193 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3194 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
- 3195 uok);
|
|
|
- 3196 isStr := FALSE;
|
|
|
- 3197 IF NOT uok THEN
|
|
|
- 3198 SemError(234);
|
|
|
- 3199 dt := SymTab.InvalidType
|
|
|
- 3200 ELSIF isU THEN
|
|
|
- 3201 (* one codepoint: a UCHAR;
|
|
|
- 3202 LEN is 1, HIGH is 0 *)
|
|
|
- 3203 dt := SymTab.UCharType();
|
|
|
- 3204 QbeGen.IntStr(ucp, qd)
|
|
|
- 3205 ELSE
|
|
|
- 3206 dt := SymTab.NewUStr();
|
|
|
- 3207 END;
|
|
|
- 3208 dk := -1;
|
|
|
- 3209 qn[0] := CHR(0); .) )
|
|
|
- 3210 ")"
|
|
|
- 3211 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3212 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
- 3213 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
- 3214 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3215 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
- 3216 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3217 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3218 IF (dt # SymTab.InvalidType)
|
|
|
- 3219 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
- 3220 (* UString: the count is
|
|
|
- 3221 the descriptor header *)
|
|
|
- 3222 t := SymTab.IntType();
|
|
|
- 3223 QbeGen.CopyOp("@", q)
|
|
|
- 3224 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 3225 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
- 3226 (* single UCHAR codepoint *)
|
|
|
- 3227 IF isHigh THEN
|
|
|
- 3228 QbeGen.CopyOp("0", qr)
|
|
|
- 3229 ELSE
|
|
|
- 3230 QbeGen.CopyOp("1", qr)
|
|
|
- 3231 END;
|
|
|
- 3232 t := SymTab.IntType();
|
|
|
- 3233 QbeGen.CopyOp(qr, q)
|
|
|
- 3234 ELSIF isStr THEN
|
|
|
- 3235 (* fold: content length at
|
|
|
- 3236 compile time *)
|
|
|
- 3237 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3238 c1 := 1
|
|
|
- 3239 ELSE
|
|
|
- 3240 c1 :=
|
|
|
- 3241 SymTab.StrLen(s) - 2
|
|
|
- 3242 END;
|
|
|
- 3243 IF isHigh THEN
|
|
|
- 3244 DEC(c1)
|
|
|
- 3245 END;
|
|
|
- 3246 QbeGen.IntStr(c1, qr);
|
|
|
- 3247 t := SymTab.IntType();
|
|
|
- 3248 QbeGen.CopyOp(qr, q)
|
|
|
- 3249 ELSIF dt = SymTab.InvalidType THEN
|
|
|
- 3250 t := SymTab.InvalidType;
|
|
|
- 3251 QbeGen.CopyOp("0", q)
|
|
|
- 3252 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 3253 SymTab.ClArray THEN
|
|
|
- 3254 SemError(217);
|
|
|
- 3255 t := SymTab.InvalidType;
|
|
|
- 3256 QbeGen.CopyOp("0", q)
|
|
|
- 3257 ELSE
|
|
|
- 3258 IF SymTab.IsOpenArray(dt) THEN
|
|
|
- 3259 t := SymTab.IntType();
|
|
|
- 3260 QbeGen.CopyOp("@", q)
|
|
|
- 3261 ELSE
|
|
|
- 3262 IF isHigh THEN
|
|
|
- 3263 QbeGen.IntStr(
|
|
|
- 3264 SymTab.ArrayHi(dt), qr)
|
|
|
- 3265 ELSE
|
|
|
- 3266 QbeGen.IntStr(VAL(
|
|
|
- 3267 INTEGER,
|
|
|
- 3268 SymTab.ArrayLen(dt)),
|
|
|
- 3269 qr)
|
|
|
- 3270 END;
|
|
|
- 3271 t := SymTab.IntType();
|
|
|
- 3272 QbeGen.CopyOp(qr, q)
|
|
|
- 3273 END
|
|
|
- 3274 END; .)
|
|
|
- 3275 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3276 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3277 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
- 3278 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3279 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3280 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3281 t := SymTab.InvalidType;
|
|
|
- 3282 QbeGen.CopyOp("0", q)
|
|
|
- 3283 ELSE
|
|
|
- 3284 QbeGen.IntStr(VAL(INTEGER,
|
|
|
- 3285 SymTab.ObjectSize(dt)), q);
|
|
|
- 3286 t := SymTab.IntType()
|
|
|
- 3287 END; .)
|
|
|
- 3288 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
- 3289 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
- 3290 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
- 3291 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3292 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3293 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
- 3294 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3295 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
- 3296 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3297 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3298 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3299 (* set shift/rotate: isMax
|
|
|
- 3300 doubles as "rotate" *)
|
|
|
- 3301 IF (et # SymTab.InvalidType)
|
|
|
- 3302 AND (SymTab.ClassOf(et) =
|
|
|
- 3303 SymTab.ClSet) THEN
|
|
|
- 3304 t := et;
|
|
|
- 3305 QbeGen.CopyOp("@", q)
|
|
|
- 3306 ELSE SemError(230);
|
|
|
- 3307 t := SymTab.InvalidType;
|
|
|
- 3308 QbeGen.CopyOp("0", q)
|
|
|
- 3309 END; .)
|
|
|
- 3310 | ( "MIN" (. isMax := FALSE; .)
|
|
|
- 3311 | "MAX" (. isMax := TRUE; .) )
|
|
|
- 3312 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3313 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3314 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3315 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
- 3316 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3317 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
- 3318 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3319 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3320 IF (dt # SymTab.InvalidType)
|
|
|
- 3321 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
- 3322 (* REAL/LONGREAL: the
|
|
|
- 3323 implementation bounds *)
|
|
|
- 3324 IF isMax THEN
|
|
|
- 3325 QbeGen.NormReal(
|
|
|
- 3326 "3.402823e38", q)
|
|
|
- 3327 ELSE QbeGen.NormReal(
|
|
|
- 3328 "-3.402823e38", q)
|
|
|
- 3329 END;
|
|
|
- 3330 t := SymTab.RealType()
|
|
|
- 3331 ELSIF (dt #
|
|
|
- 3332 SymTab.InvalidType)
|
|
|
- 3333 AND (SymTab.ClassOf(dt) =
|
|
|
- 3334 SymTab.ClLong) THEN
|
|
|
- 3335 IF isMax THEN
|
|
|
- 3336 QbeGen.CopyOp(
|
|
|
- 3337 "9223372036854775807", q)
|
|
|
- 3338 ELSE QbeGen.CopyOp(
|
|
|
- 3339 "-9223372036854775808", q)
|
|
|
- 3340 END;
|
|
|
- 3341 t := SymTab.LongType()
|
|
|
- 3342 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
- 3343 hi) THEN
|
|
|
- 3344 IF isMax THEN
|
|
|
- 3345 QbeGen.IntStr(hi, q)
|
|
|
- 3346 ELSE QbeGen.IntStr(lo, q)
|
|
|
- 3347 END;
|
|
|
- 3348 t := SymTab.IntType()
|
|
|
- 3349 ELSE SemError(230);
|
|
|
- 3350 t := SymTab.InvalidType;
|
|
|
- 3351 QbeGen.CopyOp("0", q)
|
|
|
- 3352 END; .)
|
|
|
- 3353 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3354 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3355 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
- 3356 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3357 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3358 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3359 t := SymTab.InvalidType;
|
|
|
- 3360 QbeGen.CopyOp("0", q)
|
|
|
- 3361 ELSE
|
|
|
- 3362 IF sfx
|
|
|
- 3363 OR (dk = SymTab.KindVar)
|
|
|
- 3364 OR (dk = SymTab.KindParam) THEN
|
|
|
- 3365 QbeGen.CopyOp("@", q)
|
|
|
- 3366 ELSE SemError(230);
|
|
|
- 3367 QbeGen.CopyOp("0", q)
|
|
|
- 3368 END;
|
|
|
- 3369 t := SymTab.AddrType()
|
|
|
- 3370 END; .)
|
|
|
- 3371 | "CHR" "(" Expr<et, q> ")"
|
|
|
- 3372 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3373 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
- 3374 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3375 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3376 (. IF (et # SymTab.InvalidType)
|
|
|
- 3377 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3378 SemError(211) END;
|
|
|
- 3379 t := SymTab.CharType(); .)
|
|
|
- 3380 | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
|
|
|
- 3381 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3382 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
- 3383 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3384 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3385 (. IF et # SymTab.InvalidType THEN
|
|
|
- 3386 IF (SymTab.ClassOf(et) #
|
|
|
- 3387 SymTab.ClChar)
|
|
|
- 3388 AND (SymTab.ClassOf(et) #
|
|
|
- 3389 SymTab.ClBool)
|
|
|
- 3390 AND (SymTab.ClassOf(et) #
|
|
|
- 3391 SymTab.ClEnum)
|
|
|
- 3392 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3393 SemError(211) END
|
|
|
- 3394 END;
|
|
|
- 3395 t := SymTab.IntType(); .)
|
|
|
- 3396 | "CAP" "(" Expr<et, q> ")"
|
|
|
- 3397 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3398 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
- 3399 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3400 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3401 (. QbeGen.CopyOp("@", q);
|
|
|
- 3402 t := SymTab.CharType(); .)
|
|
|
- 3403 | "UCHR" "(" Expr<et, q> ")"
|
|
|
- 3404 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3405 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
- 3406 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3407 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3408 (. (* UCHR: the UCHAR constructor.
|
|
|
- 3409 CHAR -> UCHAR (identity);
|
|
|
- 3410 INTEGER familly -> UCHAR
|
|
|
- 3411 (codepoint value). *)
|
|
|
- 3412 IF (et # SymTab.InvalidType)
|
|
|
- 3413 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
- 3414 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3415 SemError(211) END;
|
|
|
- 3416 t := SymTab.UCharType(); .)
|
|
|
- 3417 | "CHR8" "(" Expr<et, q> ")"
|
|
|
- 3418 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3419 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
- 3420 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3421 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3422 (. IF (et # SymTab.InvalidType)
|
|
|
- 3423 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 3424 SemError(211) END;
|
|
|
- 3425 t := SymTab.CharType(); .)
|
|
|
- 3426 | "UORD" "(" Expr<et, q> ")"
|
|
|
- 3427 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3428 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
- 3429 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3430 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3431 (. (* UORD(u): the codepoint as a
|
|
|
- 3432 32-bit ordinal (INTEGER),
|
|
|
- 3433 cf. ORD for CHAR. *)
|
|
|
- 3434 IF (et # SymTab.InvalidType)
|
|
|
- 3435 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 3436 SemError(211) END;
|
|
|
- 3437 t := SymTab.IntType(); .)
|
|
|
- 3438 | "ABS" "(" Expr<et, q> ")"
|
|
|
- 3439 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3440 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
- 3441 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3442 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3443 (. IF (et # SymTab.InvalidType)
|
|
|
- 3444 AND NOT SymTab.IsIntFamily(et)
|
|
|
- 3445 AND (SymTab.ClassOf(et) #
|
|
|
- 3446 SymTab.ClReal) THEN
|
|
|
- 3447 SemError(211)
|
|
|
- 3448 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3449 END;
|
|
|
- 3450 t := et; .)
|
|
|
- 3451 | "VAL" "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
- 3452 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3453 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3454 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3455 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3456 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3457 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
- 3458 SemError(201);
|
|
|
- 3459 t := SymTab.InvalidType
|
|
|
- 3460 ELSE vt := SymTab.SymType(vn);
|
|
|
- 3461 IF vt = SymTab.InvalidType THEN
|
|
|
- 3462 t := SymTab.InvalidType
|
|
|
- 3463 ELSIF et =
|
|
|
- 3464 SymTab.InvalidType THEN
|
|
|
- 3465 t := vt
|
|
|
- 3466 ELSE
|
|
|
- 3467 c1 := SymTab.ClassOf(et);
|
|
|
- 3468 c2 := SymTab.ClassOf(vt);
|
|
|
- 3469 IF (c1 = SymTab.ClInt)
|
|
|
- 3470 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 3471 QbeGen.WidenLong(q, qa);
|
|
|
- 3472 QbeGen.CopyOp(qa, q);
|
|
|
- 3473 t := vt
|
|
|
- 3474 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 3475 AND (c2 = SymTab.ClInt) THEN
|
|
|
- 3476 QbeGen.NarrowLong(q, qa);
|
|
|
- 3477 QbeGen.CopyOp(qa, q);
|
|
|
- 3478 t := vt
|
|
|
- 3479 ELSIF (c1 = SymTab.ClInt)
|
|
|
- 3480 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3481 QbeGen.ConvIR(q, qa);
|
|
|
- 3482 QbeGen.CopyOp(qa, q);
|
|
|
- 3483 t := vt
|
|
|
- 3484 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 3485 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3486 QbeGen.ConvLR(q, qa);
|
|
|
- 3487 QbeGen.CopyOp(qa, q);
|
|
|
- 3488 t := vt
|
|
|
- 3489 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3490 AND (c2 = SymTab.ClInt) THEN
|
|
|
- 3491 QbeGen.ConvRI(q, qa);
|
|
|
- 3492 QbeGen.CopyOp(qa, q);
|
|
|
- 3493 t := vt
|
|
|
- 3494 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3495 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 3496 QbeGen.ConvRL(q, qa);
|
|
|
- 3497 QbeGen.CopyOp(qa, q);
|
|
|
- 3498 t := vt
|
|
|
- 3499 ELSIF ((c1 = SymTab.ClInt)
|
|
|
- 3500 OR (c1 =
|
|
|
- 3501 SymTab.ClChar)
|
|
|
- 3502 OR (c1 =
|
|
|
- 3503 SymTab.ClBool)
|
|
|
- 3504 OR (c1 =
|
|
|
- 3505 SymTab.ClEnum))
|
|
|
- 3506 AND ((c2 = SymTab.ClInt)
|
|
|
- 3507 OR (c2 =
|
|
|
- 3508 SymTab.ClChar)
|
|
|
- 3509 OR (c2 =
|
|
|
- 3510 SymTab.ClBool)
|
|
|
- 3511 OR (c2 =
|
|
|
- 3512 SymTab.ClEnum)) THEN
|
|
|
- 3513 t := vt
|
|
|
- 3514 ELSIF (c1 = SymTab.ClPtr)
|
|
|
- 3515 AND (c2 = SymTab.ClPtr) THEN
|
|
|
- 3516 t := vt
|
|
|
- 3517 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3518 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3519 t := vt
|
|
|
- 3520 ELSE SemError(230);
|
|
|
- 3521 t := SymTab.InvalidType
|
|
|
- 3522 END
|
|
|
- 3523 END
|
|
|
- 3524 END; .)
|
|
|
- 3525 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
- 3526 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
- 3527 QbeGen.CopyOp(sq, q); .)
|
|
|
- 3528 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
- 3529 IF SymTab.BoolCheck(t2) THEN
|
|
|
- 3530 t := SymTab.BoolType()
|
|
|
- 3531 ELSE SemError(212);
|
|
|
- 3532 t := SymTab.InvalidType END;
|
|
|
- 3533 IF t # SymTab.InvalidType THEN
|
|
|
- 3534 QbeGen.CopyOp("@", q)
|
|
|
- 3535 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3536 END;
|
|
|
- 3537 astIsLit := TRUE;
|
|
|
- 3538 astCur := AST.MakeUn(
|
|
|
- 3539 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
- 3540 )
|
|
|
- 3541 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
- 3542 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3543 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
- 3544 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
- 3545 for computed elements. Ranges always lower via SetRange. *)
|
|
|
- 3546 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3547 (. VAR astNode: AST.Node; .)
|
|
|
- 3548 = "{" (. t := SymTab.NewSet(
|
|
|
- 3549 SymTab.NewSubR(0, 255));
|
|
|
- 3550 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
- 3551 QbeGen.NewSetTemp(8, q);
|
|
|
- 3552 QbeGen.SetZero(q, 8); .)
|
|
|
- 3553 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
- 3554 "}" (. astCur := astNode; .) .
|
|
|
- 3555 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
- 3556 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
- 3557 declared type sets the width (set) or element type (array). *)
|
|
|
- 3558 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3559 (. VAR nw: CARDINAL;
|
|
|
- 3560 astNode, astTail: AST.Node;
|
|
|
- 3561 savedCls: INTEGER; .)
|
|
|
- 3562 = "{" (. savedCls := braceCls;
|
|
|
- 3563 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
- 3564 AST.SetTy(astNode, vt);
|
|
|
- 3565 astTail := astNode;
|
|
|
- 3566 IF vt = SymTab.InvalidType THEN
|
|
|
- 3567 braceCls := -1
|
|
|
- 3568 ELSE braceCls :=
|
|
|
- 3569 SymTab.ClassOf(vt)
|
|
|
- 3570 END;
|
|
|
- 3571 IF braceCls = SymTab.ClSet THEN
|
|
|
- 3572 IF vt = SymTab.InvalidType THEN
|
|
|
- 3573 nw := 8
|
|
|
- 3574 ELSE nw := SymTab.SetWords(vt);
|
|
|
- 3575 IF nw = 0 THEN nw := 8 END
|
|
|
- 3576 END;
|
|
|
- 3577 QbeGen.NewSetTemp(nw, q);
|
|
|
- 3578 QbeGen.SetZero(q, nw)
|
|
|
- 3579 ELSIF (braceCls =
|
|
|
- 3580 SymTab.ClArray)
|
|
|
- 3581 OR (braceCls =
|
|
|
- 3582 SymTab.ClRecord)
|
|
|
- 3583 OR (braceCls =
|
|
|
- 3584 SymTab.ClClass) THEN
|
|
|
- 3585 QbeGen.CtorBegin(vt)
|
|
|
- 3586 ELSE
|
|
|
- 3587 IF vt # SymTab.InvalidType THEN
|
|
|
- 3588 SemError(230) END;
|
|
|
- 3589 braceCls := -1
|
|
|
- 3590 END; .)
|
|
|
- 3591 [ BraceElem<vt, q, astNode, astTail>
|
|
|
- 3592 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
- 3593 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
- 3594 OR (braceCls =
|
|
|
- 3595 SymTab.ClRecord)
|
|
|
- 3596 OR (braceCls =
|
|
|
- 3597 SymTab.ClClass) THEN
|
|
|
- 3598 QbeGen.CtorEnd(q)
|
|
|
- 3599 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
- 3600 QbeGen.CopyOp("0", q)
|
|
|
- 3601 END;
|
|
|
- 3602 braceCls := savedCls; .)
|
|
|
- 3603 (. astCur := astNode; .) .
|
|
|
- 3604 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
- 3605 VAR node, tail: AST.Node>
|
|
|
- 3606 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 3607 qe, q2: QbeGen.QVal;
|
|
|
- 3608 v, v2, reps, k: INTEGER;
|
|
|
- 3609 elem: SymTab.TypeIndex;
|
|
|
- 3610 lo: INTEGER;
|
|
|
- 3611 span: CARDINAL;
|
|
|
- 3612 cl, cl2: INTEGER;
|
|
|
- 3613 hasR, hasB: BOOLEAN;
|
|
|
- 3614 astEl: AST.Node; .)
|
|
|
- 3615 = (. hasR := FALSE; hasB := FALSE;
|
|
|
- 3616 reps := 1; .)
|
|
|
- 3617 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 3618 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 3619 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 3620 hasR := TRUE; .) ]
|
|
|
- 3621 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
- 3622 (. IF braceCls = SymTab.ClSet THEN
|
|
|
- 3623 IF hasB THEN SemError(230) END;
|
|
|
- 3624 lo := SymTab.SetBaseLo(vt);
|
|
|
- 3625 span := SymTab.SetCount(vt);
|
|
|
- 3626 IF (et = SymTab.InvalidType)
|
|
|
- 3627 OR (hasR AND (et2 =
|
|
|
- 3628 SymTab.InvalidType)) THEN
|
|
|
- 3629 ELSE cl :=
|
|
|
- 3630 SymTab.ClassOf(et);
|
|
|
- 3631 IF hasR THEN
|
|
|
- 3632 cl2 :=
|
|
|
- 3633 SymTab.ClassOf(et2)
|
|
|
- 3634 ELSE cl2 := SymTab.ClInt
|
|
|
- 3635 END;
|
|
|
- 3636 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 3637 OR (hasR AND NOT
|
|
|
- 3638 SymTab.SetElemClassOk(cl2))
|
|
|
- 3639 THEN
|
|
|
- 3640 SemError(222)
|
|
|
- 3641 ELSIF hasR
|
|
|
- 3642 AND SymTab.ConstInt(qe, v)
|
|
|
- 3643 AND SymTab.ConstInt(q2,
|
|
|
- 3644 v2)
|
|
|
- 3645 AND ((v < lo)
|
|
|
- 3646 OR (v2 < lo)
|
|
|
- 3647 OR (v >= lo +
|
|
|
- 3648 VAL(INTEGER, span))
|
|
|
- 3649 OR (v2 >= lo +
|
|
|
- 3650 VAL(INTEGER, span))
|
|
|
- 3651 OR (v > v2)) THEN
|
|
|
- 3652 SemError(222)
|
|
|
- 3653 ELSIF hasR THEN
|
|
|
- 3654 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 3655 lo, span)
|
|
|
- 3656 ELSIF SymTab.ConstInt(qe,
|
|
|
- 3657 v)
|
|
|
- 3658 AND ((v < lo)
|
|
|
- 3659 OR (v >= lo +
|
|
|
- 3660 VAL(INTEGER,
|
|
|
- 3661 span))) THEN
|
|
|
- 3662 SemError(222)
|
|
|
- 3663 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 3664 lo, span)
|
|
|
- 3665 END
|
|
|
- 3666 END
|
|
|
- 3667 ELSIF (braceCls = SymTab.ClArray)
|
|
|
- 3668 OR (braceCls =
|
|
|
- 3669 SymTab.ClRecord)
|
|
|
- 3670 OR (braceCls =
|
|
|
- 3671 SymTab.ClClass) THEN
|
|
|
- 3672 IF hasR THEN SemError(230) END;
|
|
|
- 3673 reps := 1;
|
|
|
- 3674 IF hasB THEN
|
|
|
- 3675 IF SymTab.ConstInt(q2, v2)
|
|
|
- 3676 AND (v2 >= 1) THEN
|
|
|
- 3677 reps := v2
|
|
|
- 3678 ELSE SemError(230)
|
|
|
- 3679 END
|
|
|
- 3680 END;
|
|
|
- 3681 k := 0;
|
|
|
- 3682 WHILE k < reps DO
|
|
|
- 3683 QbeGen.CtorElem(qe);
|
|
|
- 3684 INC(k)
|
|
|
- 3685 END
|
|
|
- 3686 END; .)
|
|
|
- 3687 (. (* the BY form repeats the
|
|
|
- 3688 element; keep the AST in
|
|
|
- 3689 step with CtorElem *)
|
|
|
- 3690 k := 0;
|
|
|
- 3691 WHILE k < reps DO
|
|
|
- 3692 AstAppend(AST.NkBlock,
|
|
|
- 3693 node, tail, astEl);
|
|
|
- 3694 INC(k)
|
|
|
- 3695 END; .) .
|
|
|
- 3696 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 3697 qe, q2: QbeGen.QVal;
|
|
|
- 3698 v, v2: INTEGER;
|
|
|
- 3699 lo: INTEGER;
|
|
|
- 3700 span: CARDINAL;
|
|
|
- 3701 cl, cl2: INTEGER;
|
|
|
- 3702 hasR: BOOLEAN;
|
|
|
- 3703 astEl: AST.Node; .)
|
|
|
- 3704 = (. hasR := FALSE; .)
|
|
|
- 3705 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 3706 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 3707 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 3708 hasR := TRUE; .) ]
|
|
|
- 3709 (. lo := SymTab.SetBaseLo(st);
|
|
|
- 3710 span := SymTab.SetCount(st);
|
|
|
- 3711 IF (et = SymTab.InvalidType)
|
|
|
- 3712 OR (hasR AND (et2 =
|
|
|
- 3713 SymTab.InvalidType)) THEN
|
|
|
- 3714 ELSE cl :=
|
|
|
- 3715 SymTab.ClassOf(et);
|
|
|
- 3716 IF hasR THEN
|
|
|
- 3717 cl2 :=
|
|
|
- 3718 SymTab.ClassOf(et2)
|
|
|
- 3719 ELSE cl2 := SymTab.ClInt
|
|
|
- 3720 END;
|
|
|
- 3721 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 3722 OR (hasR AND NOT
|
|
|
- 3723 SymTab.SetElemClassOk(cl2))
|
|
|
- 3724 THEN
|
|
|
- 3725 SemError(222)
|
|
|
- 3726 ELSIF hasR
|
|
|
- 3727 AND SymTab.ConstInt(qe, v)
|
|
|
- 3728 AND SymTab.ConstInt(q2,
|
|
|
- 3729 v2)
|
|
|
- 3730 AND ((v < lo)
|
|
|
- 3731 OR (v2 < lo)
|
|
|
- 3732 OR (v >= lo +
|
|
|
- 3733 VAL(INTEGER, span))
|
|
|
- 3734 OR (v2 >= lo +
|
|
|
- 3735 VAL(INTEGER, span))
|
|
|
- 3736 OR (v > v2)) THEN
|
|
|
- 3737 SemError(222)
|
|
|
- 3738 ELSIF hasR THEN
|
|
|
- 3739 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 3740 lo, span)
|
|
|
- 3741 ELSIF SymTab.ConstInt(qe,
|
|
|
- 3742 v)
|
|
|
- 3743 AND ((v < lo)
|
|
|
- 3744 OR (v >= lo +
|
|
|
- 3745 VAL(INTEGER,
|
|
|
- 3746 span))) THEN
|
|
|
- 3747 SemError(222)
|
|
|
- 3748 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 3749 lo, span)
|
|
|
- 3750 END
|
|
|
- 3751 END; .)
|
|
|
- 3752 (. AST.SetChild(node,
|
|
|
- 3753 AST.NChild(node), astEl); .) .
|
|
|
- 3754 GetIdent<VAR n: SymTab.Name>
|
|
|
- 3755 = ident (. LexName(n); .) .
|
|
|
- 3756
|
|
|
- 3757 END M2.
|
|
|
+ 2630 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 2631 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 2632 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2633 SymTab.ClPtr THEN
|
|
|
+ 2634 SemError(219);
|
|
|
+ 2635 t := SymTab.InvalidType
|
|
|
+ 2636 ELSE
|
|
|
+ 2637 bt := SymTab.PtrBase(t);
|
|
|
+ 2638 IF bt = SymTab.InvalidType THEN
|
|
|
+ 2639 ELSE
|
|
|
+ 2640 t := bt;
|
|
|
+ 2641 sfx := TRUE
|
|
|
+ 2642 END
|
|
|
+ 2643 END; .) } (. astCur := astDes; .) .
|
|
|
+ 2644 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
+ 2645 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
+ 2646 (a value, or a descriptor address for aggregates); each component
|
|
|
+ 2647 descends one level exactly like the Design components. *)
|
|
|
+ 2648 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 2649 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
+ 2650 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
+ 2651 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
+ 2652 iq, ql, qlo, qhi, qe, qb:
|
|
|
+ 2653 QbeGen.QVal;
|
|
|
+ 2654 lo, hi, fo: INTEGER;
|
|
|
+ 2655 isOpen: BOOLEAN;
|
|
|
+ 2656 fname: SymTab.Name;
|
|
|
+ 2657 astWrap, astSel: AST.Node; .)
|
|
|
+ 2658 = "[" Expr<it, iq>
|
|
|
+ 2659 (. isM := FALSE;
|
|
|
+ 2660 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 2661 astWrap := AST.MakeNode(
|
|
|
+ 2662 AST.NkDesignator);
|
|
|
+ 2663 AST.SetChild(astWrap, 0, node);
|
|
|
+ 2664 node := astWrap
|
|
|
+ 2665 END;
|
|
|
+ 2666 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 2667 AST.MakeUn(AST.NkSelector,
|
|
|
+ 2668 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2669 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2670 SymTab.ClArray THEN
|
|
|
+ 2671 SemError(217);
|
|
|
+ 2672 t := SymTab.InvalidType
|
|
|
+ 2673 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 2674 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
+ 2675 AND (SymTab.ClassOf(it) # SymTab.ClEnum) THEN
|
|
|
+ 2676 SemError(218);
|
|
|
+ 2677 t := SymTab.InvalidType
|
|
|
+ 2678 ELSE
|
|
|
+ 2679 eT := SymTab.ArrayElem(t);
|
|
|
+ 2680 t := eT; sfx := TRUE
|
|
|
+ 2681 END; .)
|
|
|
+ 2682 "]"
|
|
|
+ 2683 | "." GetIdent<fname>
|
|
|
+ 2684 (. isM := FALSE;
|
|
|
+ 2685 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 2686 astWrap := AST.MakeNode(
|
|
|
+ 2687 AST.NkDesignator);
|
|
|
+ 2688 AST.SetChild(astWrap, 0, node);
|
|
|
+ 2689 node := astWrap
|
|
|
+ 2690 END;
|
|
|
+ 2691 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 2692 AST.MakeUn(AST.NkSelector,
|
|
|
+ 2693 AST.SelField,
|
|
|
+ 2694 AST.MakeLeaf(AST.NkIdent,
|
|
|
+ 2695 fname))); IF t = SymTab.InvalidType THEN
|
|
|
+ 2696 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 2697 SymTab.ClRecord)
|
|
|
+ 2698 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 2699 SemError(215);
|
|
|
+ 2700 t := SymTab.InvalidType
|
|
|
+ 2701 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 2702 SymTab.ClClass)
|
|
|
+ 2703 AND SymTab.MethodExists(t, fname) THEN
|
|
|
+ 2704 (* a method on the call result:
|
|
|
+ 2705 a following ArgList makes
|
|
|
+ 2706 the call *)
|
|
|
+ 2707 mname := fname;
|
|
|
+ 2708 methCls := t; isM := TRUE;
|
|
|
+ 2709 t := SymTab.InvalidType
|
|
|
+ 2710 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 2711 fname) THEN
|
|
|
+ 2712 SemError(216);
|
|
|
+ 2713 t := SymTab.InvalidType
|
|
|
+ 2714 ELSE
|
|
|
+ 2715 t := SymTab.FieldType(t, fname);
|
|
|
+ 2716 sfx := TRUE
|
|
|
+ 2717 END; .)
|
|
|
+ 2718 | "^" (. isM := FALSE;
|
|
|
+ 2719 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 2720 astWrap := AST.MakeNode(
|
|
|
+ 2721 AST.NkDesignator);
|
|
|
+ 2722 AST.SetChild(astWrap, 0, node);
|
|
|
+ 2723 node := astWrap
|
|
|
+ 2724 END;
|
|
|
+ 2725 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 2726 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 2727 AST.SetChild(node,
|
|
|
+ 2728 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 2729 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2730 SymTab.ClPtr THEN
|
|
|
+ 2731 SemError(219);
|
|
|
+ 2732 t := SymTab.InvalidType
|
|
|
+ 2733 ELSE
|
|
|
+ 2734 bt := SymTab.PtrBase(t);
|
|
|
+ 2735 IF bt # SymTab.InvalidType THEN
|
|
|
+ 2736 t := bt; sfx := TRUE
|
|
|
+ 2737 END
|
|
|
+ 2738 END; .) .
|
|
|
+ 2739 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2740 (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 2741 op: INTEGER;
|
|
|
+ 2742 q2, qt, wl: QbeGen.QVal;
|
|
|
+ 2743 astA, astB: AST.Node;
|
|
|
+ 2744 astOp: INTEGER;
|
|
|
+ 2745 astMade: BOOLEAN;
|
|
|
+ 2746 isR: BOOLEAN; .)
|
|
|
+ 2747 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
+ 2748 [ Rel<op> SimExpr<t2, q2>
|
|
|
+ 2749 (. astB := astCur; astMade := TRUE;
|
|
|
+ 2750 astOp := AST.OpEq;
|
|
|
+ 2751 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
+ 2752 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
+ 2753 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
+ 2754 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
+ 2755 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
+ 2756 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
+ 2757 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
+ 2758 END;
|
|
|
+ 2759 IF op = SymTab.OpIn THEN
|
|
|
+ 2760 IF SymTab.InCheck(t, t2) THEN
|
|
|
+ 2761 IF (t = SymTab.InvalidType)
|
|
|
+ 2762 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 2763 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 2764 ELSE
|
|
|
+ 2765 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 2766 END
|
|
|
+ 2767 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
+ 2768 QbeGen.CopyOp("0", q)
|
|
|
+ 2769 END
|
|
|
+ 2770 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
+ 2771 IF (t = SymTab.InvalidType)
|
|
|
+ 2772 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 2773 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 2774 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
+ 2775 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
+ 2776 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
+ 2777 AND (op # SymTab.OpNeq2) THEN
|
|
|
+ 2778 SemError(213); t := SymTab.InvalidType;
|
|
|
+ 2779 QbeGen.CopyOp("0", q)
|
|
|
+ 2780 ELSE
|
|
|
+ 2781 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 2782 END
|
|
|
+ 2783 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 2784 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 2785 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 2786 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
+ 2787 QbeGen.StrEq(op, q, q2, qt);
|
|
|
+ 2788 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 2789 ELSIF SymTab.IsLongFamily(t)
|
|
|
+ 2790 OR SymTab.IsLongFamily(t2) THEN
|
|
|
+ 2791 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 2792 ELSE
|
|
|
+ 2793 t := SymTab.BoolType();
|
|
|
+ 2794 QbeGen.CopyOp("@", q)
|
|
|
+ 2795 END
|
|
|
+ 2796 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
+ 2797 QbeGen.CopyOp("0", q)
|
|
|
+ 2798 END;
|
|
|
+ 2799 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
+ 2800 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
+ 2801 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 2802 Rel<VAR op: INTEGER>
|
|
|
+ 2803 = "=" (. op := SymTab.OpEq; .)
|
|
|
+ 2804 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
+ 2805 | "<" (. op := SymTab.OpLt; .)
|
|
|
+ 2806 | "<=" (. op := SymTab.OpLe; .)
|
|
|
+ 2807 | ">" (. op := SymTab.OpGt; .)
|
|
|
+ 2808 | ">=" (. op := SymTab.OpGe; .)
|
|
|
+ 2809 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
+ 2810 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2811 (. VAR t2, res2, lt, rt:
|
|
|
+ 2812 SymTab.TypeIndex;
|
|
|
+ 2813 op: INTEGER;
|
|
|
+ 2814 q2, qt, wq, qf, q2a, q2b:
|
|
|
+ 2815 QbeGen.QVal;
|
|
|
+ 2816 neg, isR, isL, folded:
|
|
|
+ 2817 BOOLEAN;
|
|
|
+ 2818 fok: BOOLEAN;
|
|
|
+ 2819 lw, rw, mw: CARDINAL;
|
|
|
+ 2820 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 2821 astA, astB: AST.Node;
|
|
|
+ 2822 astSign, astOp: INTEGER; .)
|
|
|
+ 2823 = (. neg := FALSE; astSign := 0; .)
|
|
|
+ 2824 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
+ 2825 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
+ 2826 Term<t, q> (. astA := astCur;
|
|
|
+ 2827 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
+ 2828 QbeGen.NegFold(q, q)
|
|
|
+ 2829 END;
|
|
|
+ 2830 IF astSign < 0 THEN
|
|
|
+ 2831 astCur := AST.MakeUn(
|
|
|
+ 2832 AST.NkUnary, AST.OpSub, astA);
|
|
|
+ 2833 astA := astCur
|
|
|
+ 2834 END; .)
|
|
|
+ 2835 { AddOp<op>
|
|
|
+ 2836 Term<t2, q2> (. astB := astCur; .)
|
|
|
+ 2837 (. astOp := AST.OpAdd;
|
|
|
+ 2838 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
+ 2839 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
+ 2840 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 2841 astCur := astA;
|
|
|
+ 2842 IF op = SymTab.OpOr THEN
|
|
|
+ 2843 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
+ 2844 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 2845 t := SymTab.BoolType()
|
|
|
+ 2846 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 2847 IF t # SymTab.InvalidType THEN
|
|
|
+ 2848 QbeGen.CopyOp("@", q)
|
|
|
+ 2849 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2850 END
|
|
|
+ 2851 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 2852 AND (SymTab.UStrCompat(t, t2)
|
|
|
+ 2853 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 2854 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
+ 2855 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
+ 2856 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
+ 2857 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 2858 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
+ 2859 (* UString concatenation: a UCHAR operand becomes a
|
|
|
+ 2860 1-codepoint UString; the result is a descriptor in the
|
|
|
+ 2861 shim's concat buffer. Work on copies so neither
|
|
|
+ 2862 operand is clobbered. *)
|
|
|
+ 2863 t := SymTab.NewUStr();
|
|
|
+ 2864 QbeGen.CopyOp("@", q)
|
|
|
+ 2865 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 2866 AND (SymTab.StrCompat(t, t2)
|
|
|
+ 2867 OR (SymTab.IsStrType(t)
|
|
|
+ 2868 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
+ 2869 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
+ 2870 AND SymTab.IsStrType(t2))) THEN
|
|
|
+ 2871 (* string concatenation; a CHAR operand becomes a
|
|
|
+ 2872 1-character string literal. When both operands are
|
|
|
+ 2873 constants, fold to a single string literal so a
|
|
|
+ 2874 constructor element stays compile-time. *)
|
|
|
+ 2875 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
+ 2876 qt, fok);
|
|
|
+ 2877 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
+ 2878 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 2879 END;
|
|
|
+ 2880 t := SymTab.NewStr()
|
|
|
+ 2881 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 2882 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 2883 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 2884 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 2885 mw := lw;
|
|
|
+ 2886 IF rw > mw THEN mw := rw END;
|
|
|
+ 2887 t := SymTab.NewSet(
|
|
|
+ 2888 SymTab.NewSubR(0,
|
|
|
+ 2889 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 2890 QbeGen.CopyOp("@", q)
|
|
|
+ 2891 ELSE
|
|
|
+ 2892 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
+ 2893 lt := t; rt := t2; t := res2
|
|
|
+ 2894 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 2895 IF t # SymTab.InvalidType THEN
|
|
|
+ 2896 isL := SymTab.IsLongFamily(t);
|
|
|
+ 2897 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 2898 folded := FALSE;
|
|
|
+ 2899 IF (NOT isL) AND (NOT isR)
|
|
|
+ 2900 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 2901 IF op = SymTab.OpAdd THEN
|
|
|
+ 2902 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
+ 2903 ELSE
|
|
|
+ 2904 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
+ 2905 END
|
|
|
+ 2906 END;
|
|
|
+ 2907 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 2908 ELSE
|
|
|
+ 2909 QbeGen.CopyOp("@", q)
|
|
|
+ 2910 END
|
|
|
+ 2911 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2912 END
|
|
|
+ 2913 END; .) }
|
|
|
+ 2914 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 2915 AddOp<VAR op: INTEGER>
|
|
|
+ 2916 = "+" (. op := SymTab.OpAdd; .)
|
|
|
+ 2917 | "-" (. op := SymTab.OpSub; .)
|
|
|
+ 2918 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
+ 2919 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2920 (. VAR t2, res2, lt, rt:
|
|
|
+ 2921 SymTab.TypeIndex;
|
|
|
+ 2922 op: INTEGER;
|
|
|
+ 2923 q2, qt, wq, qf:
|
|
|
+ 2924 QbeGen.QVal;
|
|
|
+ 2925 isR, isL, folded: BOOLEAN;
|
|
|
+ 2926 lw, rw, mw: CARDINAL;
|
|
|
+ 2927 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 2928 astA, astB: AST.Node;
|
|
|
+ 2929 astOp: INTEGER; .)
|
|
|
+ 2930 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
+ 2931 Fact<t2, q2> (. astB := astCur; .)
|
|
|
+ 2932 (. astOp := AST.OpMul;
|
|
|
+ 2933 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
+ 2934 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
+ 2935 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
+ 2936 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
+ 2937 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 2938 astCur := astA;
|
|
|
+ 2939 IF op = SymTab.OpAnd THEN
|
|
|
+ 2940 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
+ 2941 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 2942 t := SymTab.BoolType()
|
|
|
+ 2943 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 2944 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
+ 2945 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2946 END
|
|
|
+ 2947 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 2948 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 2949 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 2950 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 2951 mw := lw;
|
|
|
+ 2952 IF rw > mw THEN mw := rw END;
|
|
|
+ 2953 t := SymTab.NewSet(
|
|
|
+ 2954 SymTab.NewSubR(0,
|
|
|
+ 2955 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 2956 QbeGen.CopyOp("@", q)
|
|
|
+ 2957 ELSE
|
|
|
+ 2958 IF SymTab.ArithCheck(t, t2,
|
|
|
+ 2959 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
+ 2960 res2) THEN
|
|
|
+ 2961 lt := t; rt := t2; t := res2
|
|
|
+ 2962 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 2963 IF t # SymTab.InvalidType THEN
|
|
|
+ 2964 isL := SymTab.IsLongFamily(t);
|
|
|
+ 2965 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 2966 folded := FALSE;
|
|
|
+ 2967 IF (NOT isL) AND (NOT isR)
|
|
|
+ 2968 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 2969 IF op = SymTab.OpTimes THEN
|
|
|
+ 2970 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
+ 2971 ELSIF op = SymTab.OpDiv THEN
|
|
|
+ 2972 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
+ 2973 ELSIF op = SymTab.OpMod THEN
|
|
|
+ 2974 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
+ 2975 END
|
|
|
+ 2976 END;
|
|
|
+ 2977 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 2978 ELSE
|
|
|
+ 2979 QbeGen.CopyOp("@", q)
|
|
|
+ 2980 END
|
|
|
+ 2981 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2982 END
|
|
|
+ 2983 END; .) }
|
|
|
+ 2984 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 2985 MulOp<VAR op: INTEGER>
|
|
|
+ 2986 = "*" (. op := SymTab.OpTimes; .)
|
|
|
+ 2987 | "/" (. op := SymTab.OpSlash; .)
|
|
|
+ 2988 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
+ 2989 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
+ 2990 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
+ 2991 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2992 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
+ 2993 et, dt, t2, st, ct2, et2:
|
|
|
+ 2994 SymTab.TypeIndex;
|
|
|
+ 2995 dk: INTEGER;
|
|
|
+ 2996 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
+ 2997 QbeGen.QVal;
|
|
|
+ 2998 qn, vn: SymTab.Name;
|
|
|
+ 2999 vt: SymTab.TypeIndex;
|
|
|
+ 3000 c1, c2: INTEGER;
|
|
|
+ 3001 lo, hi: INTEGER;
|
|
|
+ 3002 isMax: BOOLEAN;
|
|
|
+ 3003 called, isHigh, sfx, isCh,
|
|
|
+ 3004 isU, uok, isStr: BOOLEAN;
|
|
|
+ 3005 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
+ 3006 astD: AST.Node;
|
|
|
+ 3007 astCall: BOOLEAN;
|
|
|
+ 3008 astNode, astNot: AST.Node;
|
|
|
+ 3009 j: CARDINAL;
|
|
|
+ 3010 astArg2: AST.Node;
|
|
|
+ 3011 astBrace: AST.Node;
|
|
|
+ 3012 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN; .)
|
|
|
+ 3013 = (. astIsLit := FALSE; .)
|
|
|
+ 3014 ( integer (. LexString(s);
|
|
|
+ 3015 QbeGen.NormInt(s, q); IF twoPhase THEN astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s) END;
|
|
|
+ 3016 t := SymTab.IntType(); .)
|
|
|
+ 3017 | charConst (. LexString(s);
|
|
|
+ 3018 QbeGen.NormLit(s, q, isCh);
|
|
|
+ 3019 IF twoPhase THEN
|
|
|
+ 3020 astIsLit := TRUE;
|
|
|
+ 3021 astCur := AST.MakeLeaf(
|
|
|
+ 3022 AST.NkCharLit, s)
|
|
|
+ 3023 END;
|
|
|
+ 3024 t := SymTab.CharType(); .)
|
|
|
+ 3025 | real (. LexString(s);
|
|
|
+ 3026 QbeGen.NormReal(s, q);
|
|
|
+ 3027 IF twoPhase THEN
|
|
|
+ 3028 astIsLit := TRUE;
|
|
|
+ 3029 astCur := AST.MakeLeaf(
|
|
|
+ 3030 AST.NkRealLit, s)
|
|
|
+ 3031 END;
|
|
|
+ 3032 t := SymTab.RealType(); .)
|
|
|
+ 3033 | string (. LexString(s);
|
|
|
+ 3034 IF twoPhase THEN
|
|
|
+ 3035 astIsLit := TRUE;
|
|
|
+ 3036 astCur := AST.MakeLeaf(
|
|
|
+ 3037 AST.NkStrLit, s)
|
|
|
+ 3038 END;
|
|
|
+ 3039 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3040 t := SymTab.CharType();
|
|
|
+ 3041 QbeGen.IntStr(
|
|
|
+ 3042 QbeGen.CharVal(s), q)
|
|
|
+ 3043 ELSE t := SymTab.NewStr();
|
|
|
+ 3044 QbeGen.DeclStr(s, q);
|
|
|
+ 3045 (* a literal's value IS its
|
|
|
+ 3046 static descriptor address *)
|
|
|
+ 3047 END; .)
|
|
|
+ 3048 | ustring (. LexString(s);
|
|
|
+ 3049 IF twoPhase THEN
|
|
|
+ 3050 astIsLit := TRUE;
|
|
|
+ 3051 astCur := AST.MakeLeaf(
|
|
|
+ 3052 AST.NkStrLit, s)
|
|
|
+ 3053 END;
|
|
|
+ 3054 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
+ 3055 uok);
|
|
|
+ 3056 IF NOT uok THEN
|
|
|
+ 3057 SemError(234);
|
|
|
+ 3058 t := SymTab.InvalidType
|
|
|
+ 3059 ELSIF isU THEN
|
|
|
+ 3060 t := SymTab.UCharType();
|
|
|
+ 3061 QbeGen.IntStr(ucp, q)
|
|
|
+ 3062 ELSE
|
|
|
+ 3063 t := SymTab.NewUStr();
|
|
|
+ 3064 END; .)
|
|
|
+ 3065 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
+ 3066 astNArgs := 0; called := FALSE;
|
|
|
+ 3067 t := dt;
|
|
|
+ 3068 IF dk = SymTab.KindConst THEN
|
|
|
+ 3069 QbeGen.CopyOp(qd, q)
|
|
|
+ 3070 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3071 END; .)
|
|
|
+ 3072 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
+ 3073 astBrace := astCur; .) ]
|
|
|
+ 3074 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 3075 (. astCall := TRUE;
|
|
|
+ 3076 astNode := AstCallNode(astD);
|
|
|
+ 3077 astRes := astNode;
|
|
|
+ 3078 t := ct2;
|
|
|
+ 3079 QbeGen.CopyOp(q2, q);
|
|
|
+ 3080 sfx := FALSE; .)
|
|
|
+ 3081 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
+ 3082 [ (. astNArgs := 0; .)
|
|
|
+ 3083 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 3084 (. astNode := AstCallNode(astRes);
|
|
|
+ 3085 astRes := astNode;
|
|
|
+ 3086 t := ct2;
|
|
|
+ 3087 QbeGen.CopyOp(q2, q);
|
|
|
+ 3088 sfx := FALSE; .) ] }
|
|
|
+ 3089 (. IF sfx THEN
|
|
|
+ 3090 IF t = SymTab.InvalidType THEN
|
|
|
+ 3091 QbeGen.CopyOp("0", q)
|
|
|
+ 3092 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3093 SymTab.ClRecord)
|
|
|
+ 3094 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
+ 3095 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
+ 3096 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 3097 QbeGen.CopyOp("@", q)
|
|
|
+ 3098 END
|
|
|
+ 3099 END; .) ]
|
|
|
+ 3100 (. IF called THEN
|
|
|
+ 3101 astCur := astRes
|
|
|
+ 3102 ELSIF astCall THEN
|
|
|
+ 3103 astCur := astBrace
|
|
|
+ 3104 ELSE astCur := astD
|
|
|
+ 3105 END;
|
|
|
+ 3106 astIsLit := TRUE;
|
|
|
+ 3107 IF NOT called
|
|
|
+ 3108 AND (dk = SymTab.KindProc) THEN
|
|
|
+ 3109 (* bare zero-arg function
|
|
|
+ 3110 call (parentheses may be
|
|
|
+ 3111 omitted); a proper or
|
|
|
+ 3112 parameterised proc here
|
|
|
+ 3113 is 230 *)
|
|
|
+ 3114 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
+ 3115 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
+ 3116 t := SymTab.ProcRes(qn);
|
|
|
+ 3117 QbeGen.CopyOp("@", q);
|
|
|
+ 3118 astCur := AST.MakeNode(AST.NkCall);
|
|
|
+ 3119 AST.SetChild(astCur, 0, astD)
|
|
|
+ 3120 ELSE
|
|
|
+ 3121 t := SymTab.ProcTypeOf(qn);
|
|
|
+ 3122 QbeGen.CopyOp("@", q)
|
|
|
+ 3123 END
|
|
|
+ 3124 END; .)
|
|
|
+ 3125 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
+ 3126 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
+ 3127 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
+ 3128 isU := FALSE; .)
|
|
|
+ 3129 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3130 isStr := TRUE;
|
|
|
+ 3131 isU := FALSE;
|
|
|
+ 3132 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3133 dt := SymTab.CharType();
|
|
|
+ 3134 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
+ 3135 qd)
|
|
|
+ 3136 ELSE
|
|
|
+ 3137 dt := SymTab.NewStr();
|
|
|
+ 3138 QbeGen.DeclStr(s, qd);
|
|
|
+ 3139 END;
|
|
|
+ 3140 dk := -1;
|
|
|
+ 3141 qn[0] := CHR(0); .)
|
|
|
+ 3142 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3143 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
+ 3144 uok);
|
|
|
+ 3145 isStr := FALSE;
|
|
|
+ 3146 IF NOT uok THEN
|
|
|
+ 3147 SemError(234);
|
|
|
+ 3148 dt := SymTab.InvalidType
|
|
|
+ 3149 ELSIF isU THEN
|
|
|
+ 3150 (* one codepoint: a UCHAR;
|
|
|
+ 3151 LEN is 1, HIGH is 0 *)
|
|
|
+ 3152 dt := SymTab.UCharType();
|
|
|
+ 3153 QbeGen.IntStr(ucp, qd)
|
|
|
+ 3154 ELSE
|
|
|
+ 3155 dt := SymTab.NewUStr();
|
|
|
+ 3156 END;
|
|
|
+ 3157 dk := -1;
|
|
|
+ 3158 qn[0] := CHR(0); .) )
|
|
|
+ 3159 ")"
|
|
|
+ 3160 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3161 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
+ 3162 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
+ 3163 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3164 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
+ 3165 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3166 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3167 IF (dt # SymTab.InvalidType)
|
|
|
+ 3168 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
+ 3169 (* UString: the count is
|
|
|
+ 3170 the descriptor header *)
|
|
|
+ 3171 t := SymTab.IntType();
|
|
|
+ 3172 QbeGen.CopyOp("@", q)
|
|
|
+ 3173 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 3174 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
+ 3175 (* single UCHAR codepoint *)
|
|
|
+ 3176 IF isHigh THEN
|
|
|
+ 3177 QbeGen.CopyOp("0", qr)
|
|
|
+ 3178 ELSE
|
|
|
+ 3179 QbeGen.CopyOp("1", qr)
|
|
|
+ 3180 END;
|
|
|
+ 3181 t := SymTab.IntType();
|
|
|
+ 3182 QbeGen.CopyOp(qr, q)
|
|
|
+ 3183 ELSIF isStr THEN
|
|
|
+ 3184 (* fold: content length at
|
|
|
+ 3185 compile time *)
|
|
|
+ 3186 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3187 c1 := 1
|
|
|
+ 3188 ELSE
|
|
|
+ 3189 c1 :=
|
|
|
+ 3190 SymTab.StrLen(s) - 2
|
|
|
+ 3191 END;
|
|
|
+ 3192 IF isHigh THEN
|
|
|
+ 3193 DEC(c1)
|
|
|
+ 3194 END;
|
|
|
+ 3195 QbeGen.IntStr(c1, qr);
|
|
|
+ 3196 t := SymTab.IntType();
|
|
|
+ 3197 QbeGen.CopyOp(qr, q)
|
|
|
+ 3198 ELSIF dt = SymTab.InvalidType THEN
|
|
|
+ 3199 t := SymTab.InvalidType;
|
|
|
+ 3200 QbeGen.CopyOp("0", q)
|
|
|
+ 3201 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 3202 SymTab.ClArray THEN
|
|
|
+ 3203 SemError(217);
|
|
|
+ 3204 t := SymTab.InvalidType;
|
|
|
+ 3205 QbeGen.CopyOp("0", q)
|
|
|
+ 3206 ELSE
|
|
|
+ 3207 IF SymTab.IsOpenArray(dt) THEN
|
|
|
+ 3208 t := SymTab.IntType();
|
|
|
+ 3209 QbeGen.CopyOp("@", q)
|
|
|
+ 3210 ELSE
|
|
|
+ 3211 IF isHigh THEN
|
|
|
+ 3212 QbeGen.IntStr(
|
|
|
+ 3213 SymTab.ArrayHi(dt), qr)
|
|
|
+ 3214 ELSE
|
|
|
+ 3215 QbeGen.IntStr(VAL(
|
|
|
+ 3216 INTEGER,
|
|
|
+ 3217 SymTab.ArrayLen(dt)),
|
|
|
+ 3218 qr)
|
|
|
+ 3219 END;
|
|
|
+ 3220 t := SymTab.IntType();
|
|
|
+ 3221 QbeGen.CopyOp(qr, q)
|
|
|
+ 3222 END
|
|
|
+ 3223 END; .)
|
|
|
+ 3224 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3225 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3226 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
+ 3227 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3228 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3229 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3230 t := SymTab.InvalidType;
|
|
|
+ 3231 QbeGen.CopyOp("0", q)
|
|
|
+ 3232 ELSE
|
|
|
+ 3233 QbeGen.IntStr(VAL(INTEGER,
|
|
|
+ 3234 SymTab.ObjectSize(dt)), q);
|
|
|
+ 3235 t := SymTab.IntType()
|
|
|
+ 3236 END; .)
|
|
|
+ 3237 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
+ 3238 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
+ 3239 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
+ 3240 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3241 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3242 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
+ 3243 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3244 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
+ 3245 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 3246 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3247 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3248 (* set shift/rotate: isMax
|
|
|
+ 3249 doubles as "rotate" *)
|
|
|
+ 3250 IF (et # SymTab.InvalidType)
|
|
|
+ 3251 AND (SymTab.ClassOf(et) =
|
|
|
+ 3252 SymTab.ClSet) THEN
|
|
|
+ 3253 t := et;
|
|
|
+ 3254 QbeGen.CopyOp("@", q)
|
|
|
+ 3255 ELSE SemError(230);
|
|
|
+ 3256 t := SymTab.InvalidType;
|
|
|
+ 3257 QbeGen.CopyOp("0", q)
|
|
|
+ 3258 END; .)
|
|
|
+ 3259 | ( "MIN" (. isMax := FALSE; .)
|
|
|
+ 3260 | "MAX" (. isMax := TRUE; .) )
|
|
|
+ 3261 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3262 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3263 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3264 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
+ 3265 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3266 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
+ 3267 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3268 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3269 IF (dt # SymTab.InvalidType)
|
|
|
+ 3270 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
+ 3271 (* REAL/LONGREAL: the
|
|
|
+ 3272 implementation bounds *)
|
|
|
+ 3273 IF isMax THEN
|
|
|
+ 3274 QbeGen.NormReal(
|
|
|
+ 3275 "3.402823e38", q)
|
|
|
+ 3276 ELSE QbeGen.NormReal(
|
|
|
+ 3277 "-3.402823e38", q)
|
|
|
+ 3278 END;
|
|
|
+ 3279 t := SymTab.RealType()
|
|
|
+ 3280 ELSIF (dt #
|
|
|
+ 3281 SymTab.InvalidType)
|
|
|
+ 3282 AND (SymTab.ClassOf(dt) =
|
|
|
+ 3283 SymTab.ClLong) THEN
|
|
|
+ 3284 IF isMax THEN
|
|
|
+ 3285 QbeGen.CopyOp(
|
|
|
+ 3286 "9223372036854775807", q)
|
|
|
+ 3287 ELSE QbeGen.CopyOp(
|
|
|
+ 3288 "-9223372036854775808", q)
|
|
|
+ 3289 END;
|
|
|
+ 3290 t := SymTab.LongType()
|
|
|
+ 3291 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
+ 3292 hi) THEN
|
|
|
+ 3293 IF isMax THEN
|
|
|
+ 3294 QbeGen.IntStr(hi, q)
|
|
|
+ 3295 ELSE QbeGen.IntStr(lo, q)
|
|
|
+ 3296 END;
|
|
|
+ 3297 t := SymTab.IntType()
|
|
|
+ 3298 ELSE SemError(230);
|
|
|
+ 3299 t := SymTab.InvalidType;
|
|
|
+ 3300 QbeGen.CopyOp("0", q)
|
|
|
+ 3301 END; .)
|
|
|
+ 3302 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3303 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3304 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
+ 3305 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3306 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3307 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3308 t := SymTab.InvalidType;
|
|
|
+ 3309 QbeGen.CopyOp("0", q)
|
|
|
+ 3310 ELSE
|
|
|
+ 3311 IF sfx
|
|
|
+ 3312 OR (dk = SymTab.KindVar)
|
|
|
+ 3313 OR (dk = SymTab.KindParam) THEN
|
|
|
+ 3314 QbeGen.CopyOp("@", q)
|
|
|
+ 3315 ELSE SemError(230);
|
|
|
+ 3316 QbeGen.CopyOp("0", q)
|
|
|
+ 3317 END;
|
|
|
+ 3318 t := SymTab.AddrType()
|
|
|
+ 3319 END; .)
|
|
|
+ 3320 | "CHR" "(" Expr<et, q> ")"
|
|
|
+ 3321 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3322 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
+ 3323 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3324 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3325 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3326 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3327 SemError(211) END;
|
|
|
+ 3328 t := SymTab.CharType(); .)
|
|
|
+ 3329 | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
|
|
|
+ 3330 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3331 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
+ 3332 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3333 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3334 (. IF et # SymTab.InvalidType THEN
|
|
|
+ 3335 IF (SymTab.ClassOf(et) #
|
|
|
+ 3336 SymTab.ClChar)
|
|
|
+ 3337 AND (SymTab.ClassOf(et) #
|
|
|
+ 3338 SymTab.ClBool)
|
|
|
+ 3339 AND (SymTab.ClassOf(et) #
|
|
|
+ 3340 SymTab.ClEnum)
|
|
|
+ 3341 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3342 SemError(211) END
|
|
|
+ 3343 END;
|
|
|
+ 3344 t := SymTab.IntType(); .)
|
|
|
+ 3345 | "CAP" "(" Expr<et, q> ")"
|
|
|
+ 3346 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3347 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
+ 3348 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3349 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3350 (. QbeGen.CopyOp("@", q);
|
|
|
+ 3351 t := SymTab.CharType(); .)
|
|
|
+ 3352 | "UCHR" "(" Expr<et, q> ")"
|
|
|
+ 3353 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3354 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
+ 3355 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3356 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3357 (. (* UCHR: the UCHAR constructor.
|
|
|
+ 3358 CHAR -> UCHAR (identity);
|
|
|
+ 3359 INTEGER familly -> UCHAR
|
|
|
+ 3360 (codepoint value). *)
|
|
|
+ 3361 IF (et # SymTab.InvalidType)
|
|
|
+ 3362 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
+ 3363 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3364 SemError(211) END;
|
|
|
+ 3365 t := SymTab.UCharType(); .)
|
|
|
+ 3366 | "CHR8" "(" Expr<et, q> ")"
|
|
|
+ 3367 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3368 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
+ 3369 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3370 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3371 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3372 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3373 SemError(211) END;
|
|
|
+ 3374 t := SymTab.CharType(); .)
|
|
|
+ 3375 | "UORD" "(" Expr<et, q> ")"
|
|
|
+ 3376 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3377 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
+ 3378 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3379 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3380 (. (* UORD(u): the codepoint as a
|
|
|
+ 3381 32-bit ordinal (INTEGER),
|
|
|
+ 3382 cf. ORD for CHAR. *)
|
|
|
+ 3383 IF (et # SymTab.InvalidType)
|
|
|
+ 3384 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3385 SemError(211) END;
|
|
|
+ 3386 t := SymTab.IntType(); .)
|
|
|
+ 3387 | "ABS" "(" Expr<et, q> ")"
|
|
|
+ 3388 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3389 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
+ 3390 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3391 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3392 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3393 AND NOT SymTab.IsIntFamily(et)
|
|
|
+ 3394 AND (SymTab.ClassOf(et) #
|
|
|
+ 3395 SymTab.ClReal) THEN
|
|
|
+ 3396 SemError(211)
|
|
|
+ 3397 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3398 END;
|
|
|
+ 3399 t := et; .)
|
|
|
+ 3400 | "VAL" "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
+ 3401 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3402 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3403 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 3404 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3405 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3406 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
+ 3407 SemError(201);
|
|
|
+ 3408 t := SymTab.InvalidType
|
|
|
+ 3409 ELSE vt := SymTab.SymType(vn);
|
|
|
+ 3410 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3411 t := SymTab.InvalidType
|
|
|
+ 3412 ELSIF et =
|
|
|
+ 3413 SymTab.InvalidType THEN
|
|
|
+ 3414 t := vt
|
|
|
+ 3415 ELSE
|
|
|
+ 3416 c1 := SymTab.ClassOf(et);
|
|
|
+ 3417 c2 := SymTab.ClassOf(vt);
|
|
|
+ 3418 IF (c1 = SymTab.ClInt)
|
|
|
+ 3419 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 3420 QbeGen.WidenLong(q, qa);
|
|
|
+ 3421 QbeGen.CopyOp(qa, q);
|
|
|
+ 3422 t := vt
|
|
|
+ 3423 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 3424 AND (c2 = SymTab.ClInt) THEN
|
|
|
+ 3425 QbeGen.NarrowLong(q, qa);
|
|
|
+ 3426 QbeGen.CopyOp(qa, q);
|
|
|
+ 3427 t := vt
|
|
|
+ 3428 ELSIF (c1 = SymTab.ClInt)
|
|
|
+ 3429 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3430 QbeGen.ConvIR(q, qa);
|
|
|
+ 3431 QbeGen.CopyOp(qa, q);
|
|
|
+ 3432 t := vt
|
|
|
+ 3433 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 3434 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3435 QbeGen.ConvLR(q, qa);
|
|
|
+ 3436 QbeGen.CopyOp(qa, q);
|
|
|
+ 3437 t := vt
|
|
|
+ 3438 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3439 AND (c2 = SymTab.ClInt) THEN
|
|
|
+ 3440 QbeGen.ConvRI(q, qa);
|
|
|
+ 3441 QbeGen.CopyOp(qa, q);
|
|
|
+ 3442 t := vt
|
|
|
+ 3443 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3444 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 3445 QbeGen.ConvRL(q, qa);
|
|
|
+ 3446 QbeGen.CopyOp(qa, q);
|
|
|
+ 3447 t := vt
|
|
|
+ 3448 ELSIF ((c1 = SymTab.ClInt)
|
|
|
+ 3449 OR (c1 =
|
|
|
+ 3450 SymTab.ClChar)
|
|
|
+ 3451 OR (c1 =
|
|
|
+ 3452 SymTab.ClBool)
|
|
|
+ 3453 OR (c1 =
|
|
|
+ 3454 SymTab.ClEnum))
|
|
|
+ 3455 AND ((c2 = SymTab.ClInt)
|
|
|
+ 3456 OR (c2 =
|
|
|
+ 3457 SymTab.ClChar)
|
|
|
+ 3458 OR (c2 =
|
|
|
+ 3459 SymTab.ClBool)
|
|
|
+ 3460 OR (c2 =
|
|
|
+ 3461 SymTab.ClEnum)) THEN
|
|
|
+ 3462 t := vt
|
|
|
+ 3463 ELSIF (c1 = SymTab.ClPtr)
|
|
|
+ 3464 AND (c2 = SymTab.ClPtr) THEN
|
|
|
+ 3465 t := vt
|
|
|
+ 3466 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3467 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3468 t := vt
|
|
|
+ 3469 ELSE SemError(230);
|
|
|
+ 3470 t := SymTab.InvalidType
|
|
|
+ 3471 END
|
|
|
+ 3472 END
|
|
|
+ 3473 END; .)
|
|
|
+ 3474 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
+ 3475 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
+ 3476 QbeGen.CopyOp(sq, q); .)
|
|
|
+ 3477 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
+ 3478 IF SymTab.BoolCheck(t2) THEN
|
|
|
+ 3479 t := SymTab.BoolType()
|
|
|
+ 3480 ELSE SemError(212);
|
|
|
+ 3481 t := SymTab.InvalidType END;
|
|
|
+ 3482 IF t # SymTab.InvalidType THEN
|
|
|
+ 3483 QbeGen.CopyOp("@", q)
|
|
|
+ 3484 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3485 END;
|
|
|
+ 3486 astIsLit := TRUE;
|
|
|
+ 3487 astCur := AST.MakeUn(
|
|
|
+ 3488 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
+ 3489 )
|
|
|
+ 3490 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
+ 3491 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3492 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
+ 3493 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
+ 3494 for computed elements. Ranges always lower via SetRange. *)
|
|
|
+ 3495 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3496 (. VAR astNode: AST.Node; .)
|
|
|
+ 3497 = "{" (. t := SymTab.NewSet(
|
|
|
+ 3498 SymTab.NewSubR(0, 255));
|
|
|
+ 3499 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
+ 3500 QbeGen.NewSetTemp(8, q);
|
|
|
+ 3501 QbeGen.SetZero(q, 8); .)
|
|
|
+ 3502 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
+ 3503 "}" (. astCur := astNode; .) .
|
|
|
+ 3504 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
+ 3505 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
+ 3506 declared type sets the width (set) or element type (array). *)
|
|
|
+ 3507 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3508 (. VAR nw: CARDINAL;
|
|
|
+ 3509 astNode, astTail: AST.Node;
|
|
|
+ 3510 savedCls: INTEGER; .)
|
|
|
+ 3511 = "{" (. savedCls := braceCls;
|
|
|
+ 3512 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
+ 3513 AST.SetTy(astNode, vt);
|
|
|
+ 3514 astTail := astNode;
|
|
|
+ 3515 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3516 braceCls := -1
|
|
|
+ 3517 ELSE braceCls :=
|
|
|
+ 3518 SymTab.ClassOf(vt)
|
|
|
+ 3519 END;
|
|
|
+ 3520 IF braceCls = SymTab.ClSet THEN
|
|
|
+ 3521 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3522 nw := 8
|
|
|
+ 3523 ELSE nw := SymTab.SetWords(vt);
|
|
|
+ 3524 IF nw = 0 THEN nw := 8 END
|
|
|
+ 3525 END;
|
|
|
+ 3526 QbeGen.NewSetTemp(nw, q);
|
|
|
+ 3527 QbeGen.SetZero(q, nw)
|
|
|
+ 3528 ELSIF (braceCls =
|
|
|
+ 3529 SymTab.ClArray)
|
|
|
+ 3530 OR (braceCls =
|
|
|
+ 3531 SymTab.ClRecord)
|
|
|
+ 3532 OR (braceCls =
|
|
|
+ 3533 SymTab.ClClass) THEN
|
|
|
+ 3534 QbeGen.CtorBegin(vt)
|
|
|
+ 3535 ELSE
|
|
|
+ 3536 IF vt # SymTab.InvalidType THEN
|
|
|
+ 3537 SemError(230) END;
|
|
|
+ 3538 braceCls := -1
|
|
|
+ 3539 END; .)
|
|
|
+ 3540 [ BraceElem<vt, q, astNode, astTail>
|
|
|
+ 3541 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
+ 3542 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
+ 3543 OR (braceCls =
|
|
|
+ 3544 SymTab.ClRecord)
|
|
|
+ 3545 OR (braceCls =
|
|
|
+ 3546 SymTab.ClClass) THEN
|
|
|
+ 3547 QbeGen.CtorEnd(q)
|
|
|
+ 3548 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
+ 3549 QbeGen.CopyOp("0", q)
|
|
|
+ 3550 END;
|
|
|
+ 3551 braceCls := savedCls; .)
|
|
|
+ 3552 (. astCur := astNode; .) .
|
|
|
+ 3553 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
+ 3554 VAR node, tail: AST.Node>
|
|
|
+ 3555 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 3556 qe, q2: QbeGen.QVal;
|
|
|
+ 3557 v, v2, reps, k: INTEGER;
|
|
|
+ 3558 elem: SymTab.TypeIndex;
|
|
|
+ 3559 lo: INTEGER;
|
|
|
+ 3560 span: CARDINAL;
|
|
|
+ 3561 cl, cl2: INTEGER;
|
|
|
+ 3562 hasR, hasB: BOOLEAN;
|
|
|
+ 3563 astEl: AST.Node; .)
|
|
|
+ 3564 = (. hasR := FALSE; hasB := FALSE;
|
|
|
+ 3565 reps := 1; .)
|
|
|
+ 3566 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 3567 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 3568 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 3569 hasR := TRUE; .) ]
|
|
|
+ 3570 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
+ 3571 (. IF braceCls = SymTab.ClSet THEN
|
|
|
+ 3572 IF hasB THEN SemError(230) END;
|
|
|
+ 3573 lo := SymTab.SetBaseLo(vt);
|
|
|
+ 3574 span := SymTab.SetCount(vt);
|
|
|
+ 3575 IF (et = SymTab.InvalidType)
|
|
|
+ 3576 OR (hasR AND (et2 =
|
|
|
+ 3577 SymTab.InvalidType)) THEN
|
|
|
+ 3578 ELSE cl :=
|
|
|
+ 3579 SymTab.ClassOf(et);
|
|
|
+ 3580 IF hasR THEN
|
|
|
+ 3581 cl2 :=
|
|
|
+ 3582 SymTab.ClassOf(et2)
|
|
|
+ 3583 ELSE cl2 := SymTab.ClInt
|
|
|
+ 3584 END;
|
|
|
+ 3585 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 3586 OR (hasR AND NOT
|
|
|
+ 3587 SymTab.SetElemClassOk(cl2))
|
|
|
+ 3588 THEN
|
|
|
+ 3589 SemError(222)
|
|
|
+ 3590 ELSIF hasR
|
|
|
+ 3591 AND SymTab.ConstInt(qe, v)
|
|
|
+ 3592 AND SymTab.ConstInt(q2,
|
|
|
+ 3593 v2)
|
|
|
+ 3594 AND ((v < lo)
|
|
|
+ 3595 OR (v2 < lo)
|
|
|
+ 3596 OR (v >= lo +
|
|
|
+ 3597 VAL(INTEGER, span))
|
|
|
+ 3598 OR (v2 >= lo +
|
|
|
+ 3599 VAL(INTEGER, span))
|
|
|
+ 3600 OR (v > v2)) THEN
|
|
|
+ 3601 SemError(222)
|
|
|
+ 3602 ELSIF hasR THEN
|
|
|
+ 3603 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 3604 lo, span)
|
|
|
+ 3605 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 3606 v)
|
|
|
+ 3607 AND ((v < lo)
|
|
|
+ 3608 OR (v >= lo +
|
|
|
+ 3609 VAL(INTEGER,
|
|
|
+ 3610 span))) THEN
|
|
|
+ 3611 SemError(222)
|
|
|
+ 3612 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 3613 lo, span)
|
|
|
+ 3614 END
|
|
|
+ 3615 END
|
|
|
+ 3616 ELSIF (braceCls = SymTab.ClArray)
|
|
|
+ 3617 OR (braceCls =
|
|
|
+ 3618 SymTab.ClRecord)
|
|
|
+ 3619 OR (braceCls =
|
|
|
+ 3620 SymTab.ClClass) THEN
|
|
|
+ 3621 IF hasR THEN SemError(230) END;
|
|
|
+ 3622 reps := 1;
|
|
|
+ 3623 IF hasB THEN
|
|
|
+ 3624 IF SymTab.ConstInt(q2, v2)
|
|
|
+ 3625 AND (v2 >= 1) THEN
|
|
|
+ 3626 reps := v2
|
|
|
+ 3627 ELSE SemError(230)
|
|
|
+ 3628 END
|
|
|
+ 3629 END;
|
|
|
+ 3630 k := 0;
|
|
|
+ 3631 WHILE k < reps DO
|
|
|
+ 3632 QbeGen.CtorElem(qe);
|
|
|
+ 3633 INC(k)
|
|
|
+ 3634 END
|
|
|
+ 3635 END; .)
|
|
|
+ 3636 (. (* the BY form repeats the
|
|
|
+ 3637 element; keep the AST in
|
|
|
+ 3638 step with CtorElem *)
|
|
|
+ 3639 k := 0;
|
|
|
+ 3640 WHILE k < reps DO
|
|
|
+ 3641 AstAppend(AST.NkBlock,
|
|
|
+ 3642 node, tail, astEl);
|
|
|
+ 3643 INC(k)
|
|
|
+ 3644 END; .) .
|
|
|
+ 3645 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 3646 qe, q2: QbeGen.QVal;
|
|
|
+ 3647 v, v2: INTEGER;
|
|
|
+ 3648 lo: INTEGER;
|
|
|
+ 3649 span: CARDINAL;
|
|
|
+ 3650 cl, cl2: INTEGER;
|
|
|
+ 3651 hasR: BOOLEAN;
|
|
|
+ 3652 astEl: AST.Node; .)
|
|
|
+ 3653 = (. hasR := FALSE; .)
|
|
|
+ 3654 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 3655 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 3656 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 3657 hasR := TRUE; .) ]
|
|
|
+ 3658 (. lo := SymTab.SetBaseLo(st);
|
|
|
+ 3659 span := SymTab.SetCount(st);
|
|
|
+ 3660 IF (et = SymTab.InvalidType)
|
|
|
+ 3661 OR (hasR AND (et2 =
|
|
|
+ 3662 SymTab.InvalidType)) THEN
|
|
|
+ 3663 ELSE cl :=
|
|
|
+ 3664 SymTab.ClassOf(et);
|
|
|
+ 3665 IF hasR THEN
|
|
|
+ 3666 cl2 :=
|
|
|
+ 3667 SymTab.ClassOf(et2)
|
|
|
+ 3668 ELSE cl2 := SymTab.ClInt
|
|
|
+ 3669 END;
|
|
|
+ 3670 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 3671 OR (hasR AND NOT
|
|
|
+ 3672 SymTab.SetElemClassOk(cl2))
|
|
|
+ 3673 THEN
|
|
|
+ 3674 SemError(222)
|
|
|
+ 3675 ELSIF hasR
|
|
|
+ 3676 AND SymTab.ConstInt(qe, v)
|
|
|
+ 3677 AND SymTab.ConstInt(q2,
|
|
|
+ 3678 v2)
|
|
|
+ 3679 AND ((v < lo)
|
|
|
+ 3680 OR (v2 < lo)
|
|
|
+ 3681 OR (v >= lo +
|
|
|
+ 3682 VAL(INTEGER, span))
|
|
|
+ 3683 OR (v2 >= lo +
|
|
|
+ 3684 VAL(INTEGER, span))
|
|
|
+ 3685 OR (v > v2)) THEN
|
|
|
+ 3686 SemError(222)
|
|
|
+ 3687 ELSIF hasR THEN
|
|
|
+ 3688 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 3689 lo, span)
|
|
|
+ 3690 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 3691 v)
|
|
|
+ 3692 AND ((v < lo)
|
|
|
+ 3693 OR (v >= lo +
|
|
|
+ 3694 VAL(INTEGER,
|
|
|
+ 3695 span))) THEN
|
|
|
+ 3696 SemError(222)
|
|
|
+ 3697 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 3698 lo, span)
|
|
|
+ 3699 END
|
|
|
+ 3700 END; .)
|
|
|
+ 3701 (. AST.SetChild(node,
|
|
|
+ 3702 AST.NChild(node), astEl); .) .
|
|
|
+ 3703 GetIdent<VAR n: SymTab.Name>
|
|
|
+ 3704 = ident (. LexName(n); .) .
|
|
|
+ 3705
|
|
|
+ 3706 END M2.
|
|
|
|
|
|
0 errors
|
|
|
|
