{============================================================================}
{=                                                                          =}
{=      'Parser.Pas'                                                        =}
{=                                                                          =}
{=          Pascal compiler parser.                                         =}
{=                                                                          =}
{=              12/15/86 - Bruce Tomlin                                     =}
{=                                                                          =}
{============================================================================}

{$R+}           { Turn on range checking in this module }

UNIT Parser;

INTERFACE

USES
    MacDefs,
    Files,
    SymTab,
    Error,
    GetSym,
    PSyms,
    PTree,
    Optimize,
    CodeGen;


{$S Parser }    { Put this module in it's own code segment }
{$U Parser/Parser }
{$U <}


PROCEDURE DoProgram;


IMPLEMENTATION


FUNCTION Expression: PExpr;     FORWARD;


{============================================================================}
{=                                                                          =}
{=      JUNK                                                                =}
{=                                                                          =}
{=          Skips tokens until a semicolon or END token is found.           =}
{=                                                                          =}
{============================================================================}

PROCEDURE Junk;

BEGIN
    WHILE NOT (sym IN [semicolon,kEND,damnSetBug]) DO GetSym;
END;



{============================================================================}
{=                                                                          =}
{=      ERRJUNK                                                             =}
{=                                                                          =}
{=          Prints an error message and skips tokens until a semicolon or   =}
{=      END token is found.                                                 =}
{=                                                                          =}
{=      Parameters                                                          =}
{=                                                                          =}
{=          ERRTYP      A set indicating the type of error                  =}
{=          MSG         The error message                                   =}
{=                                                                          =}
{=                                                                          =}
{============================================================================}

PROCEDURE ErrJunk(errTyp: ErrSet; msg: Str255);

BEGIN
    Error(errTyp,msg);
    Junk;
END;



{============================================================================}
{=                                                                          =}
{=      EXPECT                                                              =}
{=                                                                          =}
{=          Checks if the current symbol is the one expected.  If it is,    =}
{=      the next symbol is read in, otherwise, an error message is printed  =}
{=      and tokens are skipped until a semicolon or END token is found.     =}
{=                                                                          =}
{=      Parameters                                                          =}
{=                                                                          =}
{=          EXPECTSYM   The symbol to expect                                =}
{=          EXPECTNAME  English for what was expected                       =}
{=                                                                          =}
{============================================================================}

PROCEDURE Expect(expectSym: Token; expectName: Str255);

BEGIN
    IF sym=expectSym THEN GetSym
                     ELSE ErrJunk([eSyn],Concat(expectName,' expected.'));
END;



{============================================================================}
{=                                                                          =}
{=      NEWIDENT                                                            =}
{=                                                                          =}
{=          Returns TRUE if the identifier has not been declared on this    =}
{=      symbol table level.  If the symbol was already declared, an error   =}
{=      message is printed.                                                 =}
{=                                                                          =}
{============================================================================}

FUNCTION NewIdent: BOOLEAN;

BEGIN
    NewIdent := TRUE;
    IF AlreadyDeclared(idPtr) THEN BEGIN
        NewIdent := FALSE;
        Error([eSem],'Identifier already declared.');
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DOMOREVARIABLE                                                      =}
{=                                                                          =}
{=          Parses the 'component variable' and 'field variable' parts      =}
{=      of the syntax.                                                      =}
{=                                                                          =}
{============================================================================}

PROCEDURE DoMoreVariable(VAR node: PTree);

VAR
    p:      PTree;
    rp:     SymPtr;

BEGIN
    CASE sym OF
        dot:    BEGIN
                    GetSym; { Eat the '.' token }
                    IF node^.exprType^.idTyp<>tRECORD THEN
                        Error([eSem],'Record type expected.')
                    ELSE BEGIN
                        IF sym<>ident THEN Expect(ident,'Identifier')
                        ELSE BEGIN
                            rp := FindRecord(node^.exprType,id);
                            IF rp=NIL THEN
                                Error([eSem],'Field not found in record.')
                            ELSE BEGIN
                                p := NewPNode(pFieldRef);
                                p^.exprType := rp;
                                p^.tree1 := node;
                                p^.sym1 := rp;
                                node := p;
                                DoMoreVariable(node);
                            END;
                        END;
                    END;
                END;
        lbrack: BEGIN
                    GetSym; { Eat the '[' token }
                    IF node^.exprType^.idTyp<>tARRAY THEN
                        Error([eSem],'Array type expected.')
                    ELSE BEGIN
                        p := NewPNode(pArrayRef);
                        p^.exprType := node^.exprType^.arrayTyp;
                        p^.tree1 := node;
                        p^.tree2 := Expression;
                        node := p;
                        WHILE sym=comma DO BEGIN
                            GetSym; { Eat the ',' token }
                            IF node^.exprType^.idTyp<>tARRAY THEN
                                Error([eSem],'Too many subscripts.')
                            ELSE BEGIN
                                p := NewPNode(pArrayRef);
                                p^.exprType := node^.exprType^.arrayTyp;
                                p^.tree1 := node;
                                p^.tree2 := Expression;
                                node := p;
                            END;
                        END;
                        Expect(rbrack,'"]"');
                        DoMoreVariable(node);
                    END;
                END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DOVARIABLE                                                          =}
{=                                                                          =}
{=          Parses the 'variable' part of the syntax.                       =}
{=                                                                          =}
{============================================================================}

FUNCTION DoVariable: PTree;

VAR
    p:      PTree;

BEGIN
    p := NIL;
    IF sym<>ident THEN Expect(ident,'Identifier')
    ELSE IF idPtr=NIL THEN ErrJunk([eSem],'Identifier not declared.')
    ELSE IF idPtr^.typ<>tVAR THEN Error([eSem],'Variable expected.')
    ELSE BEGIN
        p := NewPNode(pVariable);
        p^.exprType := idPtr;
        p^.sym1 := idPtr;
        GetSym; { Eat the identifier token }
        DoMoreVariable(p);
    END;
    DoVariable := p;
END;



{============================================================================}
{=                                                                          =}
{=      DOCONSTANT                                                          =}
{=                                                                          =}
{=          Parses the 'constant' part of the syntax.                       =}
{=                                                                          =}
{=      Parameters                                                          =}
{=                                                                          =}
{=          INTVAL      The value of an integer constant                    =}
{=          REALVAL     The value of a real constant                        =}
{=                                                                          =}
{=      Returns TRUE if the constant is a real constant.                    =}
{=                                                                          =}
{============================================================================}

FUNCTION DoConstant(VAR intVal: INTEGER; VAR realVal: REAL): BOOLEAN;

BEGIN
    { If anything goes wrong, DoConstant  }
    { will return an integer constant = 0 }

    intVal  := 0;
    realVal := 0.0;
    DoConstant := FALSE;

    CASE sym OF
        ident:      BEGIN
                        IF idPtr=NIL THEN
                            ErrJunk([eSem],'Identifier not declared.')
                        ELSE WITH idPtr^ DO BEGIN
                            IF typ<>tCONST THEN
                                Error([eSem],'Identifier not a constant.')
                            ELSE BEGIN
                                intVal  := intValue;
                                realVal := realValue;
                                DoConstant := (idTyp=tREAL);
                            END;
                        END;
                        GetSym;
                    END;

        plus:       BEGIN
                        GetSym;
                        DoConstant := DoConstant(intVal,realVal);
                    END;

        minus:      BEGIN
                        GetSym;
                        DoConstant := DoConstant(intVal,realVal);
                        intVal  := -intVal;
                        realVal := -realVal;
                    END;

        intConst:   BEGIN
                        intVal := intNum;
                        DoConstant := FALSE;
                        GetSym;
                    END;

        realConst:  BEGIN
                        realVal := realNum;
                        DoConstant := TRUE;
                        GetSym;
                    END;

        OTHERWISE   Error([eSyn],'Invalid constant.');
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DOTYPE                                                              =}
{=                                                                          =}
{=          Parses the 'type' part of the syntax.                           =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          SP      Pointer to the symbol table entry to be filled in       =}
{=                                                                          =}
{============================================================================}

PROCEDURE DoType(sp: SymPtr);


    {========================================================================}
    {=                                                                      =}
    {=      GETENUM                                                         =}
    {=                                                                      =}
    {=          Gets a new identifier for the 'scalar type' part of the     =}
    {=      syntax.                                                         =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the symbol table entry to be filled in   =}
    {=          VALUE   The value to set this identifier to                 =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE GetEnum(sp: SymPtr; value: INTEGER);

    BEGIN
        IF sym<>ident THEN Expect(ident,'Identifier')
        ELSE IF NewIdent THEN BEGIN
            AddEnum(sp,id,value);
            GetSym;
        END;
    END;


    {========================================================================}
    {=                                                                      =}
    {=      DOENUM                                                          =}
    {=                                                                      =}
    {=          Parses the 'scalar type' part of the syntax.                =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the symbol table entry to be filled in   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoEnum(sp: SymPtr);

    VAR
        value: INTEGER;

    BEGIN
        value := 0;
        MakeEnum(sp);
        GetSym;
        GetEnum(sp,value);
        WHILE sym=comma DO BEGIN
            GetSym;
            value := value + 1;
            GetEnum(sp,value);
        END;
        Expect(rparen,'")"');
        sp^.hiEnum := value;
    END;


    {========================================================================}
    {=                                                                      =}
    {=      DORANGE                                                         =}
    {=                                                                      =}
    {=          Parses the 'subrange type' part of the syntax.              =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the symbol table entry to be filled in   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoRange(sp: SymPtr);

    VAR
        lBound:     INTEGER;
        hBound:     INTEGER;
        realVal:    REAL;

    BEGIN
        IF DoConstant(lBound,realVal) THEN
            Error([eSem],'Expected integer constant.')
        ELSE BEGIN
            Expect(range,'".."');
            IF DoConstant(hBound,realVal) THEN
                Error([eSem],'Expected integer constant.')
            ELSE BEGIN
                IF hBound < lBound THEN BEGIN
                    Error([eSem],'High bound lower than low bound.');
                    hBound := lBound;
                END;
                MakeSubrange(sp,lBound,hBound);
            END;
        END;
    END;


    {========================================================================}
    {=                                                                      =}
    {=      DOSIMPLETYPE                                                    =}
    {=                                                                      =}
    {=          Parses the 'simple type' part of the syntax.                =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the symbol table entry to be filled in   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoSimpleType(sp: SymPtr);

    BEGIN
        CASE sym OF
            lparen:     DoEnum(sp);
            ident:      BEGIN
                            IF idPtr=NIL THEN
                                ErrJunk([eSem],'Identifier not declared.')
                            ELSE CASE idPtr^.typ OF
                                tCONST:     DoRange(sp);
                                tTYPE:      BEGIN
                                                CopyType(sp,idPtr);
                                                GetSym;
                                            END;
                                OTHERWISE
                                    Error([eSem],'Invalid type identifier.');
                            END;
                        END;
            intConst:   DoRange(sp);
            OTHERWISE   ErrJunk([eSyn],'Invalid type specification.');
        END;
    END;


    {========================================================================}
    {=                                                                      =}
    {=      ARRAYBOUNDS                                                     =}
    {=                                                                      =}
    {=          Fills in the array bounds for one dimension.                =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the symbol table entry to be filled in   =}
    {=          BOUNDS  Pointer to the symbol record containing the bounds  =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE ArrayBounds(sp: SymPtr; bounds: SymPtr);

    BEGIN
        CASE bounds^.idTyp OF
            tINT:       WITH sp^ DO BEGIN
                            loBound := 0;
                            hiBound := bounds^.intValue;
                        END;
            tSubrange:  WITH sp^ DO BEGIN
                            loBound := bounds^.loVal;
                            hiBound := bounds^.hiVal;
                        END;
            tEnum:      WITH sp^ DO BEGIN
                            loBound := 0;
                            hiBound := bounds^.hiEnum;
                        END;
            OTHERWISE   Error([eSyn],'Invalid array bounds.');
        END;
    END;


    {========================================================================}
    {=                                                                      =}
    {=      ARRAYSIZE                                                       =}
    {=                                                                      =}
    {=          Computes the size of an array type.                         =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the array's symbol table entry           =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE ArraySize(sp: SymPtr);

    BEGIN
        WITH sp^ DO BEGIN
            IF arrayTyp^.idTyp=tARRAY THEN ArraySize(arrayTyp);
            size := arrayTyp^.size * (hiBound-loBound+1);
        END;
    END;


    {========================================================================}
    {=                                                                      =}
    {=      DOARRAY                                                         =}
    {=                                                                      =}
    {=          Parses the 'array type' part of the syntax.                 =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the symbol table entry to be filled in   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoArray(sp: SymPtr);

    VAR
        bounds:     SymPtr;
        curBound:   SymPtr;
        elemTyp:    SymPtr;

    BEGIN
        New(bounds);
        GetSym;
        elemTyp := MakeArray(sp);
        Expect(lbrack,'"["');
        DoSimpleType(bounds);
        ArrayBounds(sp,bounds);
        curBound := sp;
        WHILE sym=comma DO BEGIN
            GetSym;
            DoSimpleType(bounds);
            AddDimension(curBound,elemTyp);
            ArrayBounds(curBound,bounds);
        END;
        Expect(rbrack,'"]"');
        Expect(kOF,'"OF"');
        DoType(elemTyp);
        Dispose(bounds);
        ArraySize(sp);
    END;


    {========================================================================}
    {=                                                                      =}
    {=      DORECORDSECTION                                                 =}
    {=                                                                      =}
    {=          Parses the 'record section' part of the syntax.             =}
    {=                                                                      =}
    {=          SP      Pointer to the symbol table entry to be filled in   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoRecordSection(sp: SymPtr);

    TYPE
        NodePtr = ^Node;
        Node =  RECORD
                    next:   NodePtr;
                    name:   Str255;
                END;

    VAR
        idList:     NodePtr;
        p:          NodePtr;
        q:          NodePtr;
        entry:      SymPtr;
        entry1:     SymPtr;

    BEGIN
        IF sym=ident THEN BEGIN
            New(idList);
            p := idList;
            p^.name := id;
            p^.next := NIL;
            GetSym;
            WHILE sym=comma DO BEGIN
                GetSym; { Eat the ',' token }
                IF sym<>ident THEN Error([eSyn],'Identifier expected.')
                ELSE BEGIN
                    New(q);
                    p^.next := q;
                    p := q;
                    p^.name := id;
                    p^.next := NIL;
                END;
                GetSym;
            END;
            Expect(colon,'":"');
            entry1 := AddRecord(sp,idList^.name);
            DoType(entry1);
            p := idList^.next;
            WHILE p<>NIL DO BEGIN
                entry := AddRecord(sp,p^.name);
                CopyType(entry,entry1);
                q := p^.next;
                Dispose(p);
                p := q;
            END;
        END;
    END;


    {========================================================================}
    {=                                                                      =}
    {=      DORECORD                                                        =}
    {=                                                                      =}
    {=          Parses the 'record type' part of the syntax.                =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the symbol table entry to be filled in   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoRecord(sp: SymPtr);

    BEGIN
        GetSym; { Eat the 'RECORD' token }
        MakeRecord(sp);
        DoRecordSection(sp);
        WHILE sym=semicolon DO BEGIN
            GetSym; { Eat the ';' token }
            DoRecordSection(sp);
        END;
        WITH sp^ DO
            IF firstElem=NIL THEN size := 0
                             ELSE size := firstElem^.offset+firstElem^.size;
        Expect(kEND,'"END"');
    END;


BEGIN { of DoType }
    CASE sym OF
        kARRAY:     DoArray(sp);
        kRECORD:    DoRecord(sp);
        OTHERWISE   DoSimpleType(sp);
    END;
END; { of DoType }



{============================================================================}
{=                                                                          =}
{=      NUMEXPR                                                             =}
{=                                                                          =}
{=          Checks to make sure an expression returns a numeric type.       =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          THEEXPR     The expression to check the type of                 =}
{=                                                                          =}
{=      Returns TRUE if the expression is numeric.  If the expression is    =}
{=      not numeric, an error message is printed and FALSE is returned.     =}
{=                                                                          =}
{============================================================================}

FUNCTION NumExpr(theExpr: PExpr): BOOLEAN;

VAR
    ok:     BOOLEAN;

BEGIN
    ok := theExpr<>NIL;
    IF ok THEN ok := theExpr^.exprType^.idTyp IN [tINT,tREAL];
    IF NOT ok THEN Error([eSem],'Integer or real expression expected.');
    NumExpr := ok;
END;



{============================================================================}
{=                                                                          =}
{=      BOOLEXPR                                                            =}
{=                                                                          =}
{=          Evaluates an expression and checks to make sure it can be used  =}
{=      as a test expression for an IF or WHILE statement.  The expression  =}
{=      is converted to integer if necessary.                               =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          THEEXPR     The expression to check the type of                 =}
{=                                                                          =}
{=      Returns TRUE if the expression can be used as a test expression.    =}
{=      If the expression can not be used, an error message is printed and  =}
{=      FALSE is returned.                                                  =}
{=                                                                          =}
{============================================================================}

FUNCTION BoolExpr(VAR p: PExpr): BOOLEAN;

VAR
    q:      PExpr;

BEGIN
    p := Expression;
    BoolExpr := FALSE;
    IF NumExpr(p) THEN BEGIN
        IF p^.exprType^.idTyp=tREAL THEN BEGIN
            q := NewPNode(pReal2Int);
            WITH q^ DO BEGIN
                exprType := intSym;
                tree1    := p;
            END;
            p := q;
        END;
        BoolExpr := TRUE;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      RESULTTYPE                                                          =}
{=                                                                          =}
{=          Returns a pointer to the type that the expression should        =}
{=      return.  Performs type conversion of an integer type to a real      =}
{=      type if one expression is integer and the other is real.            =}
{=      It is an error if either of the expressions is not integer or real. =}
{=      (But that should have been taken care of by calling NumExpr!)       =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          LEFT        The left side expression tree                       =}
{=          RIGHT       The right side expression tree                      =}
{=                                                                          =}
{============================================================================}

FUNCTION ResultType(VAR left,right: PExpr): SymPtr;

VAR
    t1:     IDType; { Type of left expression }
    t2:     IDType; { Type of right expression }
    p:      PExpr;  { Pointer to type conversion node }

BEGIN
    { Get expression types }

    t1 := left ^.exprType^.idTyp;
    t2 := right^.exprType^.idTyp;

    { Check for type match and validity, convert if necessary }

    IF ((t1=tREAL) AND (t2=tREAL)) OR ((t1=tINT) AND (t2=tINT)) THEN
        ResultType := left^.exprType
    ELSE IF (t1=tREAL) AND (t2=tINT) THEN BEGIN
        p := NewPNode(pInt2Real);
        p^.exprType := realSym;
        p^.tree1 := right;
        right := p;
        ResultType := left^.exprType;
    END
    ELSE IF (t1=tINT) AND (t2=tREAL) THEN BEGIN
        p := NewPNode(pInt2Real);
        p^.exprType := realSym;
        p^.tree1 := left;
        left := p;
        ResultType := right^.exprType;
    END
    ELSE BEGIN
        Error([eSem],'Integer or real expression expected.');
        ResultType := left^.exprType;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      ACTUALVARIABLE                                                      =}
{=                                                                          =}
{=          Returns TRUE if the parse tree refers to an actual variable.    =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          P       The expression tree to check                            =}
{=                                                                          =}
{============================================================================}

FUNCTION ActualVariable(p: PExpr): BOOLEAN;

BEGIN
    ActualVariable := p^.typ IN [pVariable,pArrayRef,pFieldRef];
END;



{============================================================================}
{=                                                                          =}
{=      PROCCALLPARMS                                                       =}
{=                                                                          =}
{=          Parses the parameters for procedure or function calls.          =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          P       The procedure parse tree node to get parameters for     =}
{=                                                                          =}
{============================================================================}

PROCEDURE ProcCallParms(VAR p: PTree);

VAR
    pp:     ParamPtr;   { Pointer to current parameter definition }
    abort:  BOOLEAN;    { TRUE if a parameter list error has occured }
    parm:   PExpr;      { Pointer to current parameter expression }
    t1:     IDType;     { Expected parameter type }
    t2:     IDType;     { Type of parameter expression }
    q:      PExpr;      { Pointer to type conversion node }

BEGIN
    pp := p^.sym1^.parms;
    IF sym=lparen THEN BEGIN    { Are any parameters given? }
        abort := FALSE;
        REPEAT
            GetSym;                 { Eat the '(' or ',' token }
            parm := Expression;     { Evaluate the parameter expression }
            IF pp=NIL THEN BEGIN    { Check if the parameter is expected }
                Error([eSem],'Too many parameters for function/procedure.');
                FreePTree(p);
                abort := TRUE;
            END
            ELSE BEGIN
                { Check parameter type, convert if necessary }

                t1 := pp^.typ^.idTyp;
                t2 := parm^.exprType^.idTyp;
                IF t1<>t2 THEN BEGIN
                    IF (t1=tINT) AND (t2=tREAL) THEN BEGIN
                        q := NewPNode(pReal2Int);
                        q^.exprType := intSym;
                        q^.tree1 := parm;
                        parm := q;
                    END
                    ELSE IF (t1=tREAL) AND (t2=tINT) THEN BEGIN
                        q := NewPNode(pInt2Real);
                        q^.exprType := realSym;
                        q^.tree1 := parm;
                        parm := q;
                    END
                    ELSE BEGIN
                        Error([eSem],'Parameter expression is wrong type.');
                        FreePTree(p);
                        abort := TRUE;
                    END;
                END;

                { Check to make sure that the expression refers to    }
                { an actual variable if a VAR parameter is specified. }

                IF (NOT abort) AND (pp^.isVar) THEN
                    IF NOT ActualVariable(parm) THEN BEGIN
                        ErrJunk([eSem],'Actual variable required.');
                        FreePTree(p);
                        abort := TRUE;
                    END;

                pp := pp^.next;
            END;
            IF NOT abort THEN AddTree(p^.tree1,parm);
        UNTIL (sym<>comma) OR abort;
        IF NOT abort THEN Expect(rparen,'")"');
    END

    { If no parameters are given, make sure none are expected. }

    ELSE IF pp<>NIL THEN BEGIN
        Error([eSem],'Parameter list expected');
        FreePTree(p);
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DOFUNCCALL                                                          =}
{=                                                                          =}
{=          Parses a function call in an expression.                        =}
{=                                                                          =}
{=      Returns a pointer to the parse tree element for the function call.  =}
{=                                                                          =}
{============================================================================}

FUNCTION DoFuncCall: PExpr;

VAR
    p:      PExpr;
    pp:     ParamPtr;
    abort:  BOOLEAN;
    parm:   PExpr;

BEGIN
    p := NewPNode(pFuncCall);
    p^.exprType := idPtr^.funcType;
    p^.sym1 := idPtr;
    GetSym;             { Eat the identifier token }
    ProcCallParms(p);   { Parse the parameter list }
    DoFuncCall := p;
END;



{============================================================================}
{=                                                                          =}
{=      FACTOR                                                              =}
{=                                                                          =}
{=          Parses the 'factor' part of the syntax.                         =}
{=                                                                          =}
{============================================================================}

FUNCTION Factor: PExpr;

VAR
    p,q:    PExpr;

BEGIN
    p := NIL;
    CASE sym OF
        ident:      BEGIN
                        IF idPtr=NIL THEN ErrJunk([eSem],'Identifier not declared.')
                        ELSE IF idPtr^.typ =  tFUNC  THEN p := DoFuncCall
                        ELSE IF idPtr^.typ <> tCONST THEN p := DoVariable
                        ELSE BEGIN
                            GetSym;     { Eat the constant identifier's token }
                            CASE idPtr^.idTyp OF
                                tINT:   BEGIN
                                            p := NewPNode(pIntConst);
                                            p^.exprType := intSym;
                                            p^.intValue := idPtr^.intValue;
                                        END;
                                tREAL:  BEGIN
                                            p := NewPNode(pRealConst);
                                            p^.exprType := realSym;
                                            p^.realValue := idPtr^.realValue;
                                        END;
                            END;
                        END;
                    END;
        intConst:   BEGIN
                        p := NewPNode(pIntConst);
                        p^.exprType := intSym;
                        p^.intValue := intNum;
                        GetSym;     { Eat the integer token }
                    END;
        realConst:  BEGIN;
                        p := NewPNode(pRealConst);
                        p^.exprType := realSym;
                        p^.realValue := realNum;
                        GetSym;     { Eat the real number token }
                    END;
        lparen:     BEGIN
                        GetSym;     { Eat the '(' token }
                        p := Expression;
                        Expect(rparen,'")"');
                    END;
        OTHERWISE   ErrJunk([eSyn],'Illegal expression.');
    END;
    IF p=NIL THEN BEGIN     { Set a bad expression to equal zero }
        p := NewPNode(pIntConst);
        p^.exprType := intSym;
        p^.intValue := 0;
    END;
    Factor := p;
END;



{============================================================================}
{=                                                                          =}
{=      TERM                                                                =}
{=                                                                          =}
{=          Parses the 'term' part of the syntax.                           =}
{=                                                                          =}
{============================================================================}

FUNCTION Term: PExpr;

VAR
    p,q:        PExpr;
    t:          PNodeType;  { Type of parse tree node to make }
    right:      PExpr;      { Right side expression tree }
(*  t1:         IDType;     { Type of left expression }
    t2:         IDType;     { Type of right expression }
*)
BEGIN
    p := Factor;
    WHILE sym IN [times,divide,kDIV,damnSetBug] DO BEGIN
        CASE sym OF
            times:  t := pMult;
            divide: t := pRDiv;
            kDIV:   t := pIDiv;
        END;
        GetSym;     { Eat the '*', '/' or 'DIV' token }
        IF NumExpr(p) THEN BEGIN
            right := Factor;
            IF NumExpr(right) THEN BEGIN
            (*  t1 := p^.exprType^.idTyp;
                t2 := right^.exprType^.idTyp;

                CASE t OF
                    pRDiv:  IF (t1=tINT)  AND (t2=tINT)  THEN {nasty situation};
                    pIDiv:  IF (t1=tREAL) AND (t2=tREAL) THEN {nasty situation};
                END;
            *)
                q := p;
                p := NewPNode(t);
                p^.exprType := ResultType(q,right);
                p^.tree1 := q;
                p^.tree2 := right;

            END;
        END;
    END;
    Term := p;
END;



{============================================================================}
{=                                                                          =}
{=      SIMPLEEXPRESSION                                                    =}
{=                                                                          =}
{=          Parses the 'simple expression' part of the syntax.              =}
{=                                                                          =}
{============================================================================}

FUNCTION SimpleExpression: PExpr;

VAR
    p,q:        PExpr;
    t:          PNodeType;  { Type of parse tree node to make }
    negate:     BOOLEAN;    { TRUE if negation node needs to be added }
    right:      PExpr;      { Right side expression tree }

BEGIN
    negate := FALSE;
    CASE sym OF
        plus:   GetSym;     { Eat the '+' token }
        minus:  BEGIN
                    GetSym;     { Eat the '-' token }
                    negate := TRUE;
                END;
    END;

    p := Term;
    IF negate THEN BEGIN
        IF NumExpr(p) THEN BEGIN
            q := p;
            p := NewPNode(pNeg);
            p^.exprType := p^.exprType;
            p^.tree1 := q;
        END;
    END;

    WHILE sym IN [plus,minus,damnSetBug] DO BEGIN
        CASE sym OF
            plus:   t := pAdd;
            minus:  t := pSub;
        END;
        GetSym;     { Eat the '+' or '-' token }
        IF NumExpr(p) THEN BEGIN
            right := Term;
            IF NumExpr(right) THEN BEGIN
                q := p;
                p := NewPNode(t);
                p^.exprType := ResultType(q,right);
                p^.tree1 := q;
                p^.tree2 := right;
            END;
        END;
    END;
    SimpleExpression := p;
END;



{============================================================================}
{=                                                                          =}
{=      EXPRESSION                                                          =}
{=                                                                          =}
{=          Parses the 'expression' part of the syntax.                     =}
{=                                                                          =}
{============================================================================}

FUNCTION Expression: PExpr;

VAR
    p,q:        PExpr;
    t:          PNodeType;  { Type of parse tree node to make }
    right:      PExpr;      { Right side expression tree }
    t1:         IDType;
    t2:         IDType;
    dummy:      SymPtr;

BEGIN
    p := SimpleExpression;
    IF sym IN [eq,neq,lt,geq,gt,leq,damnSetBug] THEN BEGIN
        CASE sym OF
            eq:     t := pEq;
            neq:    t := pNeq;
            lt:     t := pLt;
            geq:    t := pGeq;
            gt:     t := pGt;
            leq:    t := pLeq;
        END;
        GetSym;     { Eat the operator token }
        IF NumExpr(p) THEN BEGIN
            right := SimpleExpression;
            IF NumExpr(right) THEN BEGIN
                q := p;
                p := NewPNode(t);
                p^.exprType := intSym;
                dummy := ResultType(q,right);
                p^.tree1 := q;
                p^.tree2 := right;
            END;
        END;
    END;
    Expression := p;
END;



{============================================================================}
{=                                                                          =}
{=      DOBLOCK                                                             =}
{=                                                                          =}
{=          Parses the 'block' part of the syntax.                          =}
{=                                                                          =}
{=      Parameters                                                          =}
{=                                                                          =}
{=          LEVEL       The current nesting level                           =}
{=                                                                          =}
{============================================================================}

PROCEDURE DoBlock(level: INTEGER; procPtr: SymPtr);



    {========================================================================}
    {=                                                                      =}
    {=      STATEMENT                                                       =}
    {=                                                                      =}
    {=          Parses the 'statement' part of the syntax.                  =}
    {=                                                                      =}
    {========================================================================}

    FUNCTION Statement: PTree;

    VAR
        p:      PTree;


        {====================================================================}
        {=                                                                  =}
        {=      DOIF                                                        =}
        {=                                                                  =}
        {=          Parses the 'if statement' part of the syntax.           =}
        {=                                                                  =}
        {====================================================================}

        FUNCTION DoIf: PTree;

        VAR
            p:      PTree;

        BEGIN
            GetSym;     { Eat the 'IF' token }
            p := NewPNode(pIF);
            IF BoolExpr(p^.tree1) THEN BEGIN
                Expect(kTHEN,'"THEN"');
                p^.tree2 := Statement;
                IF sym=kELSE THEN BEGIN
                    GetSym;
                    p^.tree3 := Statement;
                END;
            END
            ELSE FreePTree(p);
            DoIf := p;
        END;


        {====================================================================}
        {=                                                                  =}
        {=      DOWHILE                                                     =}
        {=                                                                  =}
        {=          Parses the 'while statement' part of the syntax.        =}
        {=                                                                  =}
        {====================================================================}

        FUNCTION DoWhile: PTree;

        VAR
            p:      PTree;

        BEGIN
            GetSym;     { Eat the 'WHILE' token }
            p := NewPNode(pWHILE);
            IF BoolExpr(p^.tree1) THEN BEGIN
                Expect(kDO,'"DO"');
                p^.tree2 := Statement;
            END
            ELSE FreePTree(p);
            DoWhile := p;
        END;


        {====================================================================}
        {=                                                                  =}
        {=      DOFOR                                                       =}
        {=                                                                  =}
        {=          Parses the 'for statement' part of the syntax.          =}
        {=                                                                  =}
        {====================================================================}

        FUNCTION DoFor: PTree;

        VAR
            p:      PTree;

        BEGIN
            GetSym;     { Eat the 'FOR' token }
            p := NewPNode(pFOR);
            p^.tree1 := DoVariable;
            Expect(becomes,'":="');
            p^.tree2 := Expression;
            Expect(kTO,'"TO"');
            p^.tree3 := Expression;
            Expect(kDO,'"DO"');
            p^.tree4 := Statement;
            DoFor := p;
        END;


        {====================================================================}
        {=                                                                  =}
        {=      DOASSIGNMENT                                                =}
        {=                                                                  =}
        {=          Parses the 'assignment statement' part of the syntax.   =}
        {=                                                                  =}
        {====================================================================}

        FUNCTION DoAssignment: PTree;

        VAR
            p:      PTree;
            q:      PTree;  { Pointer to type conversion node }
            t1:     IDType; { Variable type of right side }
            t2:     IDType; { Variable type of left side }

        BEGIN
            p := NewPNode(pAssign);
            WITH p^ DO BEGIN
                p^.tree1 := DoVariable;
                Expect(becomes,'":="');
                p^.tree2 := Expression;
                IF p^.tree2=NIL THEN FreePTree(p)
                ELSE BEGIN
                    t1 := tree1^.exprType^.idTyp;
                    t2 := tree2^.exprType^.idTyp;
                    IF ((t1=tREAL) AND (t2=tREAL)) OR
                        ((t1=tINT) AND (t2=tINT)) THEN
                        { Everything is ok...the types are assignment compatible }
                    ELSE IF (t1=tREAL) AND (t2=tINT) THEN BEGIN
                        q := NewPNode(pInt2Real);
                        q^.exprType := realSym;
                        q^.tree1 := p^.tree2;
                        p^.tree2 := q;
                    END
                    ELSE IF (t1=tINT) AND (t2=tREAL) THEN BEGIN
                        q := NewPNode(pReal2Int);
                        q^.exprType := intSym;
                        q^.tree1 := p^.tree2;
                        p^.tree2 := q;
                    END
                    ELSE BEGIN
                        Error([eSem],'Operands are not assignment compatible.');
                        FreePTree(p);
                    END;
                END;
                DoAssignment := p;
            END;
        END;


        {====================================================================}
        {=                                                                  =}
        {=      DOPROCCALL                                                  =}
        {=                                                                  =}
        {=          Parses the 'procedure statement' part of the syntax.    =}
        {=                                                                  =}
        {====================================================================}

        FUNCTION DoProcCall: PTree;

        VAR
            p:      PTree;

        BEGIN
            p := NewPNode(pProcCall);
            p^.sym1 := idPtr;
            GetSym; { Eat the identifier token }
            ProcCallParms(p);
            DoProcCall := p;
        END;


        {====================================================================}
        {=                                                                  =}
        {=      DOWRITELN                                                   =}
        {=                                                                  =}
        {=          Parses a WriteLn statement.                             =}
        {=                                                                  =}
        {====================================================================}

        FUNCTION DoWriteLn: PTree;

        VAR
            p:      PTree;
            q:      PExpr;

        BEGIN
            GetSym;     { Eat the 'WriteLn' token }
            IF sym<>lparen THEN Expect(lparen,'"("')
            ELSE BEGIN
                GetSym;     { Eat the '(' token }
                q := Expression;
                IF NumExpr(q) THEN BEGIN
                    IF sym<>rparen THEN Expect(rparen,'")"')
                    ELSE BEGIN
                        GetSym;     { Eat the ')' token }
                        p := NewPNode(pProcCall);
                        WITH p^ DO BEGIN
                            tree1 := q;
                            CASE q^.exprType^.idTyp OF
                                tINT:   sym1 := wrtIntSym;
                                tREAL:  sym1 := wrtRealSym;
                            END;
                        END;
                    END;
                END;
            END;
            DoWriteLn := p;
        END;


    BEGIN { of Statement }
        p := NIL;
        CASE sym OF
            semicolon,
            kEND,
            kELSE:  ;   { Null statement }

            kBEGIN:     BEGIN
                            Expect(kBEGIN,'"BEGIN"');
                            WHILE sym<>kEND DO BEGIN
                                AddTree(p,Statement);
                                IF sym<>kEND THEN
                                    Expect(semicolon,'";" or "END"');
                            END;
                            GetSym; { Eat the 'END' token }
                        END;

            kIF:        p := DoIf;
            kWHILE:     p := DoWhile;
            KFOR:       p := DoFor;
            kWriteLn:   p := DoWriteLn;

            ident:      BEGIN
                            IF idPtr=NIL THEN
                                ErrJunk([eSem],'Identifier not declared.')
                            ELSE IF idPtr^.typ=tPROC THEN p := DoProcCall
                                                     ELSE p := DoAssignment;
                        END;
            OTHERWISE   ErrJunk([eSyn],'Illegal statement.');
        END;
        Statement := p;
    END; { of Statement }


    {========================================================================}
    {=                                                                      =}
    {=      DOCONSTDECL                                                     =}
    {=                                                                      =}
    {=          Parses the 'constant definition part' part of the syntax.   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoConstDecl;


        {====================================================================}
        {=                                                                  =}
        {=      DOCONSTDEF                                                  =}
        {=                                                                  =}
        {=          Parses the 'constant definition' part of the syntax.    =}
        {=                                                                  =}
        {====================================================================}

        PROCEDURE DoConstDef;

        VAR
            constID:    Str255;
            intVal:     INTEGER;
            realVal:    REAL;
            sp:         SymPtr;

        BEGIN
            IF sym<>ident THEN Expect(ident,'identifier')
            ELSE IF NewIdent THEN BEGIN
                constID := id;
                GetSym;
                Expect(eq,'"="');
                IF DoConstant(intVal,realVal)
                    THEN sp := AddRealConst(constID,realVal)
                    ELSE sp := AddIntConst (constID,intVal );
                Expect(semicolon,'";"');
            END;
        END;


    BEGIN { of DoConstDecl }
        GetSym; { Eat 'CONST' token }
        REPEAT
            DoConstDef;
        UNTIL sym<>ident;
    END; { of DoConstDecl }


    {========================================================================}
    {=                                                                      =}
    {=      DOTYPEDECL                                                      =}
    {=                                                                      =}
    {=          Parses the 'type definition part' part of the syntax.       =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoTypeDecl;


        {====================================================================}
        {=                                                                  =}
        {=      DOTYPEDEF                                                   =}
        {=                                                                  =}
        {=          Parses the 'type definition' part of the syntax.        =}
        {=                                                                  =}
        {====================================================================}

        PROCEDURE DoTypeDef;

        VAR
            typeID: Str255;
            sp:     SymPtr;

        BEGIN
            IF sym<>ident THEN Expect(ident,'identifier')
            ELSE IF NewIdent THEN BEGIN
                typeID := id;
                GetSym;
                Expect(eq,'"="');
                sp := AddType(typeID);
                DoType(sp);
                Expect(semicolon,'";"');
            END
        END;


    BEGIN { of DoTypeDecl }
        GetSym; { Eat 'TYPE' token }
        REPEAT
            DoTypeDef;
        UNTIL sym<>ident;
    END; { of DoTypeDecl }


    {========================================================================}
    {=                                                                      =}
    {=      DOVARDECL                                                       =}
    {=                                                                      =}
    {=          Parsesthe 'variable definition part' part of the syntax.   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoVarDecl;


        {====================================================================}
        {=                                                                  =}
        {=      DOVARDEF                                                    =}
        {=                                                                  =}
        {=          Parses the 'variable definition' part of the syntax.    =}
        {=                                                                  =}
        {====================================================================}

        PROCEDURE DoVarDef;

        TYPE
            NodePtr = ^Node;
            Node =  RECORD
                        next:   NodePtr;
                        name:   Str255;
                    END;

        VAR
            idList:     NodePtr;
            p:          NodePtr;
            q:          NodePtr;
            sp:         SymPtr;
            entry1:     SymPtr;

        BEGIN
            IF sym<>ident THEN Expect(ident,'Identifier')
            ELSE BEGIN
                New(idList);
                p := idList;
                p^.name := id;
                p^.next := NIL;
                GetSym;
                WHILE sym=comma DO BEGIN
                    GetSym;
                    IF sym<>ident THEN Error([eSyn],'Identifier expected.')
                    ELSE BEGIN
                        New(q);
                        p^.next := q;
                        p := q;
                        p^.name := id;
                        p^.next := NIL;
                    END;
                    GetSym;
                END;
                Expect(colon,'":"');
                entry1 := AddVar(idList^.name);
                DoType(entry1);
                VarOffset(procPtr,entry1);
                p := idList^.next;
                WHILE p<>NIL DO BEGIN
                    sp := AddVar(p^.name);
                    CopyType(sp,entry1);
                    VarOffset(procPtr,sp);
                    q := p^.next;
                    Dispose(p);
                    p := q;
                END;
                Expect(semicolon,'";"');
            END;
        END;


    BEGIN { of DoVarDecl }
        GetSym; { Eat 'VAR' token }
        REPEAT
            DoVarDef;
        UNTIL sym<>ident;
    END; { of DoVarDecl }


    {========================================================================}
    {=                                                                      =}
    {=      DOPARM                                                          =}
    {=                                                                      =}
    {=          Parses the 'formal parameter section' part of the syntax.   =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the procedure to add the parameters to   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoParm(sp: SymPtr);

    TYPE
        NodePtr = ^Node;
        Node =  RECORD
                    next:   NodePtr;
                    name:   Str255;
                END;

    VAR
        idList:     NodePtr;
        p:          NodePtr;
        q:          NodePtr;

    VAR
        isVar:      BOOLEAN;

    BEGIN
        isVar := (sym=kVAR);
        IF isVar THEN GetSym;
        IF sym<>ident THEN Expect(ident,'Identifier')
        ELSE BEGIN
            New(idList);
            p := idList;
            p^.name := id;
            p^.next := NIL;
            GetSym;
            WHILE sym=comma DO BEGIN
                GetSym;
                IF sym<>ident THEN Error([eSyn],'Identifier expected.')
                ELSE BEGIN
                    New(q);
                    p^.next := q;
                    p := q;
                    p^.name := id;
                    p^.next := NIL;
                END;
                GetSym;
            END;
            Expect(colon,'":"');
            IF sym<>ident THEN Expect(ident,'Type identifier')
            ELSE IF idPtr=NIL THEN ErrJunk([eSem],'Identifier not declared.')
            ELSE BEGIN
                p := idList;
                WHILE p<>NIL DO BEGIN
                    AddParm(sp,p^.name,idPtr,isVar);
                    q := p^.next;
                    Dispose(p);
                    p := q;
                END;
                GetSym; { Eat the type identifier }
            END;
        END;
    END;


    {========================================================================}
    {=                                                                      =}
    {=      DOPARMS                                                         =}
    {=                                                                      =}
    {=          Parses the parameter part of the 'procedure heading' and    =}
    {=      'function heading' parts of the syntax.                         =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the procedure to add the parameters to   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoParms(sp: SymPtr);

    BEGIN
        GetSym; { Eat the '(' token }
        DoParm(sp);
        WHILE sym=semicolon DO BEGIN
            GetSym; { Eat the ';' token }
            DoParm(sp);
        END;
        Expect(rparen,'")"');
    END;



    {========================================================================}
    {=                                                                      =}
    {=      DOPROCFUNC                                                      =}
    {=                                                                      =}
    {=          Parses the 'procedure and function declaration part' of     =}
    {=      the syntax.                                                     =}
    {=                                                                      =}
    {=      Parameters:                                                     =}
    {=                                                                      =}
    {=          SP      Pointer to the procedure to add the parameters to   =}
    {=                                                                      =}
    {========================================================================}

    PROCEDURE DoProcFunc;

    VAR
        sp:     SymPtr;
        isFunc: BOOLEAN;

    BEGIN
        isFunc := sym=kFUNCTION;
        GetSym; { Eat 'PROCEDURE' or 'FUNCTION' token }
        IF sym<>ident THEN Expect(ident,'Identifier')
        ELSE BEGIN
            sp := AddProc(id);
            GetSym; { Eat the identifier token }
            IF sym=lparen THEN DoParms(sp);
            IF isFunc THEN BEGIN
                Expect(colon,'":"');
                IF sym<>ident THEN Expect(ident,'Type identifier')
                ELSE IF idPtr=NIL THEN ErrJunk([eSem],'Identifier not declared.')
                ELSE BEGIN
                    MakeFunc(sp,idPtr);
                    GetSym; { Eat the identifier token }
                END;
            END;
            Expect(semicolon,'";"');
            DoBlock(level+1,sp);
            Expect(semicolon,'";"');
        END;
    END;


VAR
    p:      PTree;

BEGIN { of DoBlock }
    { Link in a new symbol table for this block }

    IF level>0 THEN AddSymTab(NewSymTab,level);

    WITH procPtr^ DO BEGIN
        varSize  := 0;
        parmSize := 8;  { 4 for frame link + 4 for return address }
        IF level>1 THEN parmSize := 12;     { Add 4 for static link }
    END;

    EnterParms(procPtr);

    WHILE sym IN [kCONST,kTYPE,kVAR,kPROCEDURE,kFUNCTION] DO
        CASE sym OF
            kCONST:     DoConstDecl;
            kTYPE:      DoTypeDecl;
            kVAR:       DoVarDecl;
            kPROCEDURE,
            kFUNCTION:  DoProcFunc;
        END;

    p := NIL;
    Expect(kBEGIN,'"BEGIN"');
    WHILE sym<>kEND DO BEGIN
        AddTree(p,Statement);
        IF sym<>kEND THEN Expect(semicolon,'";" or "END"');
    END;
    GetSym; { Eat the 'END' token }

    IF symDumpFlag  THEN DumpSymTab(symTab);    { Print out the symbol table }

    IF optConstExpr AND treeDumpFlag THEN DumpPTree(p);
    IF optConstExpr THEN OptimizeConstExprs(p); { Optimize constant expressions }

    IF treeDumpFlag THEN DumpPTree(p);          { Print out the parse tree }

    DumpProcedure(p,procPtr);

    IF level>0 THEN FreeSymTab(symTab); { Unlink this block's symbol table }
    FreePTree(p);       { Get rid of this block's parse tree }

END; { of DoBlock }



{============================================================================}
{=                                                                          =}
{=      DOPROGRAM                                                           =}
{=                                                                          =}
{=          Parses the 'program' part of the syntax.                        =}
{=                                                                          =}
{============================================================================}

PROCEDURE DoProgram;

VAR
    p:      SymPtr; { Fake symbol entry for main procedure }

BEGIN
    { Initialize the symbol table }

    symTab := NIL;
    AddSymTab(NewSymTab,0);
    StdTypes;   { Initialize the standard types INTEGER and REAL }
    InitGetSym; { Initialize the lexical analyzer and keywords }

    Expect(kPROGRAM,'"PROGRAM"');
    IF sym=ident THEN BEGIN
        { Make a fake procedure symbol entry to fool the other }
        { routines into thinking the main program is a procedure }

        New(p);
        WITH p^ DO BEGIN
            name     := HeapString(id);
            next     := NIL;
            typ      := tPROC;
            idTyp    := tNoType;
            size     := 0;
            offset   := 0;
            parent   := NIL;
            parms    := NIL;
            funcType := NIL;
        END;

        { Output program header code }

        ProgramHeader(p^.name^);

        { Eat the program name token and the semicolon after it }

        GetSym;
        Expect(semicolon,'";"');

        { Compile the program code }

        DoBlock(0,p);

        { Check for the dot of 'END.' }

        IF sym<>dot THEN Error([eSyn],'"." expected.');

        { Output program trailer code }

        ProgramTrailer(p^.name^,symTab);

        { Get rid of the fake procedure symbol entry }

        DisposPtr(POINTER(p^.name));
        Dispose(p);
    END
    ELSE Error([eSyn],'Program name expected.');
END;

END.