{============================================================================}
{=                                                                          =}
{=      'CodeGen.Pas'                                                       =}
{=                                                                          =}
{=          Pascal compiler code generator.                                 =}
{=                                                                          =}
{=              12/15/86 - Bruce Tomlin                                     =}
{=                                                                          =}
{============================================================================}

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

UNIT CodeGen;

INTERFACE

USES
    MacDefs,
    Files,
    SymTab,
    Error,
    PTree;


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


PROCEDURE ProgramHeader(programName: Str255);
PROCEDURE DumpProcedure(code: PTree; procPtr: SymPtr);
PROCEDURE ProgramTrailer(programName: Str255; mainSymTab: SymTabPtr);


IMPLEMENTATION


VAR
    nextLabel:      INTEGER;    { The next label number to generate }
    procLevel:      INTEGER;    { Declaration level of procedure being coded }


PROCEDURE VarAddr(code: PExpr);         FORWARD;
PROCEDURE DumpExpr(code: PExpr);        FORWARD;
PROCEDURE DumpStatements(code: PTree);  FORWARD;



{============================================================================}
{=                                                                          =}
{=      GETLABEL                                                            =}
{=                                                                          =}
{=          Returns a new label number.                                     =}
{=                                                                          =}
{============================================================================}

FUNCTION GetLabel: INTEGER;

BEGIN
    GetLabel  := nextLabel;
    nextLabel := nextLabel + 1;
END;



{============================================================================}
{=                                                                          =}
{=      WRITELABEL                                                          =}
{=                                                                          =}
{=          Writes a label reference to the output file.                    =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          LAB     The label number to output                              =}
{=                                                                          =}
{============================================================================}

PROCEDURE WriteLabel(lab: INTEGER);

BEGIN
    Write(outFile,'_',lab);
END;



{============================================================================}
{=                                                                          =}
{=      WRITEVAR                                                            =}
{=                                                                          =}
{=          Writes a variable reference to the output file.                 =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          LAB     The label number to output                              =}
{=                                                                          =}
{============================================================================}

PROCEDURE WriteVar(sp: SymPtr);

BEGIN
    WITH sp^ DO
        IF parent^.level=0 THEN Write(outFile,name^,'(A5)')
                           ELSE Write(outFile,offset,'(A6)');
END;



{============================================================================}
{=                                                                          =}
{=      ARGSIZEERR                                                          =}
{=                                                                          =}
{=          Prints out an error message indicating that an expression       =}
{=      node code generator procedure got a variable which wasn't an        =}
{=      INTEGER or a REAL.                                                  =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          WHERE   A string indicating where the error occurred.           =}
{=                                                                          =}
{============================================================================}

PROCEDURE ArgSizeErr(where: Str255);

BEGIN
    Error([eCod],Concat('Argument size error in parse tree in ',where));
END;



{============================================================================}
{=                                                                          =}
{=      PROGRAMHEADER                                                       =}
{=                                                                          =}
{=          Prints out the code to be included at the beginning of the      =}
{=      assembly language output file.                                      =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          PROGRAMNAME     The name of the program/main procedure          =}
{=                                                                          =}
{============================================================================}

PROCEDURE ProgramHeader(programName: Str255);

BEGIN
    nextLabel := 1;
    WriteLn(outFile,'    JMP     ',programName);
    WriteLn(outFile);
    WriteLn(outFile,'    INCLUDE IOProcs.Asm');
    WriteLn(outFile);
END;



{============================================================================}
{=                                                                          =}
{=      PROGRAMTRAILER                                                      =}
{=                                                                          =}
{=          Prints out the code to be included at the end of the            =}
{=      assembly language output file.                                      =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          PROGRAMNAME     The name of the program/main procedure          =}
{=          MAINSYMTAB      A pointer to the symbol table contaning globals =}
{=                                                                          =}
{============================================================================}

PROCEDURE ProgramTrailer(programName: Str255; mainSymTab: SymTabPtr);

VAR
    i:      INTEGER;
    p:      SymPtr;

BEGIN
    FOR i := 1 TO symTabSiz DO BEGIN
        p := mainSymTab^.entry[i];
        WHILE p<>NIL DO WITH p^ DO BEGIN
            IF typ=tVAR THEN BEGIN
                WriteLn(outFile,name^,':');
                WriteLn(outFile,'    DS.B    ',size);
                IF Odd(size) THEN WriteLn(outFile,'    .ALIGN  2');
            END;
            p := next;
        END;
    END;
    WriteLn(outFile);
    WriteLn(outFile,'    END     ',programName);
END;



{============================================================================}
{=                                                                          =}
{=      PROCENTRY                                                           =}
{=                                                                          =}
{=          Generates code for a procedure entry.                           =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          PROCNAME    The procedure name                                  =}
{=          VARSIZE     The total size of all local variables               =}
{=                                                                          =}
{============================================================================}

PROCEDURE ProcEntry(procPtr: SymPtr);

BEGIN
    WITH procPtr^ DO BEGIN
        IF parent=NIL THEN BEGIN
            WriteLn(outFile,name^,':');
            WriteLn(outFile,'    MOVEA.W #0,A6');   { No previous stack frame }
            WriteLn(outFile,'    LINK    A6,#0');   { Create main stack frame }
            WriteLn(outFile,'    JSR     _Init');   { Initialize I/O routines }
        END
        ELSE BEGIN
            WriteLn(outFile,name^,':');
            WriteLn(outFile,'    LINK    A6,#',varSize);
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      PROCEXIT                                                            =}
{=                                                                          =}
{=          Generates code for procedure exit.                              =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          PARMSIZE    The total size of the parameters                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE ProcExit(procPtr: SymPtr);

VAR
    whichAdd:   String[8];

BEGIN
    WITH procPtr^ DO BEGIN
        IF parent=NIL THEN WriteLn(outFile,'    JSR     _Exit');
        WriteLn(outFile,'    UNLK    A6');
        CASE parmSize OF
                8:      WriteLn(outFile,'    RTS');
                12:     BEGIN
                            WriteLn(outFile,'    MOVE.L  (A7)+,(A7)');
                            WriteLn(outFile,'    RTS');
                        END;
            OTHERWISE   BEGIN
                            WriteLn(outFile,'    MOVE.L  (A7)+,A0');
                            IF parmSize>16 THEN whichAdd := 'ADDA.W  '
                                           ELSE whichAdd := 'ADDQ.W  ';
                            WriteLn(outFile,'    ',whichAdd,'#',
                                                        parmSize-8,',A7');
                            WriteLn(outFile,'    JMP     (A0)');
                        END;
        END;
    END;
    WriteLn(outFile);
END;



{============================================================================}
{=                                                                          =}
{=      JUMP                                                                =}
{=                                                                          =}
{=          Generates code for a jump to a compiler label.                  =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          LAB         The label number to jump to                         =}
{=                                                                          =}
{============================================================================}

PROCEDURE Jump(lab: INTEGER);

BEGIN
    Write(outFile,'    JMP     ');
    WriteLabel(lab);
    WriteLn(outFile);
    WriteLn(outFile);
END;



{============================================================================}
{=                                                                          =}
{=      LABELHERE                                                           =}
{=                                                                          =}
{=          Generates code for a defining a compiler label.                 =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          LAB         The label number to define                          =}
{=                                                                          =}
{============================================================================}

PROCEDURE LabelHere(lab: INTEGER);

BEGIN
    WriteLabel(lab);
    WriteLn(outFile,':');
END;



{============================================================================}
{=                                                                          =}
{=      TEST                                                                =}
{=                                                                          =}
{=          Generates code for a conditional jump to a compiler label.      =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CONDITION   The condition on which to jump                      =}
{=          LAB         The label number to jump to                         =}
{=                                                                          =}
{============================================================================}

PROCEDURE Test(condition: Str255; lab: INTEGER);

BEGIN
    WriteLn(outFile,'    TST.W   D0');
    Write  (outFile,'    B',condition,'     ');
    WriteLabel(lab);
    WriteLn(outFile);
END;



{============================================================================}
{=                                                                          =}
{=      VARIABLEADDR                                                        =}
{=                                                                          =}
{=          Generates code for the address of a variable.                   =}
{=          The address is put into the A0 register.                        =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE VariableAddr(code: PExpr);

VAR
    varLevel:   INTEGER;

BEGIN
    WITH code^ DO BEGIN
        varLevel := sym1^.parent^.level;

        { If the variable wasn't declared in this procedure and }
        { it isn't a global, we need to deref the static links. }

        IF (varLevel<>0) AND (varLevel<>procLevel+1) THEN
            Error([eCod],'Static link code not implemented yet.');

        { If the variable is a parameter and is either a VAR parameter }
        { or is larger than 4 bytes, it is passed by pointer; deref it }

        IF (sym1^.offset>0) AND ((sym1^.varParm) OR (sym1^.size>4)) THEN BEGIN
            Write(outFile,'    MOVEA.L ');
            WriteVar(sym1);
            WriteLn(outFile,',A0');
        END

        { Otherwise, just get it's address }

        ELSE BEGIN
            Write(outFile,'    LEA     ');
            WriteVar(sym1);
            WriteLn(outFile,',A0');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      ARRAYREFADDR                                                        =}
{=                                                                          =}
{=          Generates code for the address of an array element.             =}
{=          The address is put into the A0 register.                        =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE ArrayRefAddr(code: PExpr);

VAR
    lo:     INTEGER;    { Lower bound of array }
    off:    INTEGER;    { Offset in bytes to array element }
    size:   INTEGER;    { Size of array element }

BEGIN
    WITH code^ DO BEGIN
        VarAddr(tree1);
        lo   := tree1^.exprType^.loBound;
        size := tree1^.exprType^.arrayTyp^.size;

        IF tree2^.typ = pIntConst THEN BEGIN
            off := (tree2^.intValue - lo) * size;
            IF off<>0 THEN IF (0<off) AND (off<=8)
                THEN WriteLn(outFile,'    ADDQ.W  #',off,',A0')
                ELSE WriteLn(outFile,'    ADDA.W  #',off,',A0');
        END

        ELSE BEGIN
            WriteLn(outFile,'    MOVE.L  A0,-(A7)');
            DumpExpr(tree2);
            IF lo<>0 THEN IF (0<lo) AND (lo<=8)
                THEN WriteLn(outFile,'    SUBQ.W  #',lo,',D0')
                ELSE WriteLn(outFile,'    SUB.W   #',lo,',D0');
            CASE size OF
                    1:      ; { Multiplication by 1 is generally useless }
                    2:      WriteLn(outFile,'    LSR.W   #1,D0');
                    4:      WriteLn(outFile,'    LSR.W   #2,D0');
                    8:      WriteLn(outFile,'    LSR.W   #4,D0');
                    16:     WriteLn(outFile,'    LSR.W   #8,D0');
                OTHERWISE   WriteLn(outFile,'    MULU    #',size,',D0');
            END;
            WriteLn(outFile,'    ADD.W   (A7)+,D0');
            WriteLn(outFile,'    MOVE.L  D0,A0');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      FIELDREFADDR                                                        =}
{=                                                                          =}
{=          Generates code for the address of a field record.               =}
{=          The address is put into the A0 register.                        =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE FieldRefAddr(code: PExpr);

VAR
    off:    INTEGER;

BEGIN
    WITH code^ DO BEGIN
        VarAddr(tree1);
        off := sym1^.offset;
        IF off<>0 THEN IF (0<off) AND (off<=8)
            THEN WriteLn(outFile,'    ADDQ.W  #',off,',A0')
            ELSE WriteLn(outFile,'    ADDA.W  #',off,',A0');
    END;
END;



{============================================================================}
{=                                                                          =}
{=      VARADDR                                                             =}
{=                                                                          =}
{=          Generates code for the address of a variable reference.         =}
{=          The address is put into the A0 register.                        =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE VarAddr(code: PExpr);

BEGIN
    IF code<>NIL THEN WITH code^ DO CASE typ OF
        pVariable:  VariableAddr(code);
        pArrayRef:  ArrayRefAddr(code);
        pFieldRef:  FieldRefAddr(code);
        OTHERWISE   Error([eCod],'Unknown store node type.');
    END;
END;



{============================================================================}
{=                                                                          =}
{=      PROCFUNCCALL                                                        =}
{=                                                                          =}
{=          Generates code for the common part of a procedure or function   =}
{=      call.                                                               =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE ProcFuncCall(code: PTree);

VAR
    p:      PExpr;
    pp:     ParamPtr;

BEGIN
    WITH code^ DO BEGIN
        p  := tree1;
        pp := sym1^.parms;
        WHILE (p<>NIL) AND (pp<>NIL) DO WITH p^ DO BEGIN
            IF (pp^.isVar) OR (pp^.typ^.size>4) THEN BEGIN
                VarAddr(p);
                WriteLn(outFile,'    MOVE.L  A0,-(A7)');
            END
            ELSE BEGIN
                DumpExpr(p);
                IF p^.exprType^.size<=2
                    THEN WriteLn(outFile,'    MOVE.W  D0,-(A7)')
                    ELSE WriteLn(outFile,'    MOVE.L  D0,-(A7)');
            END;
            p  := next;
            pp := pp^.next;
        END;

        IF sym1^.parent^.level>0 THEN BEGIN
            WriteLn(outFile,'    CLR.L   -(A7)');
            Error([eCod],'Static link code not implemented yet.');
        END;

        WriteLn(outfile,'    JSR     ',sym1^.name^);
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPFUNCCALL                                                        =}
{=                                                                          =}
{=          Generates code for a function call.                             =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpFuncCall(code: PExpr);

BEGIN
    IF code^.exprType^.size<=2 THEN BEGIN
        WriteLn(outFile,'    SUBQ.W  #2,A7');
        ProcFuncCall(code);
        WriteLn(outFile,'    MOVE.W  (A7)+,D0');
    END
    ELSE BEGIN
        WriteLn(outFile,'    SUBQ.W  #4,A7');
        ProcFuncCall(code);
        WriteLn(outFile,'    MOVE.L  (A7)+,D0');
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPVARIABLE                                                        =}
{=                                                                          =}
{=          Generates code for a variable reference.                        =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpVariable(code: PExpr);

VAR
    varLevel:   INTEGER;

BEGIN
    WITH code^ DO BEGIN
        varLevel := sym1^.parent^.level;

        { If the variable wasn't declared in this procedure and }
        { it isn't a global, we need to deref the static links. }

        IF (varLevel<>0) AND (varLevel<>procLevel+1) THEN
            Error([eCod],'Static link code not implemented yet.');

        { If it is a VAR parameter, we need to get }
        { the address of the actual variable first }

        IF sym1^.varParm THEN BEGIN
            Write(outFile,'    MOVEA.L ');
            WriteVar(sym1);
            WriteLn(outFile,',A0');
            CASE exprType^.idTyp OF
                tINT:       WriteLn(outFile,'    MOVE.W  (A0),D0');
                tREAL:      WriteLn(outFile,'    MOVE.L  (A0),D0');
                OTHERWISE   ArgSizeErr('DumpVariable');
            END;
        END

        { Otherwise, just get it's contents }

        ELSE CASE exprType^.idTyp OF
            tINT:       BEGIN
                            Write(outFile,'    MOVE.W  ');
                            WriteVar(sym1);
                            WriteLn(outFile,',D0');
                        END;
            tREAL:      BEGIN
                            Write(outFile,'    MOVE.L  ');
                            WriteVar(sym1);
                            WriteLn(outFile,',D0');
                        END;
            OTHERWISE   ArgSizeErr('DumpVariable');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPARRAYREF                                                        =}
{=                                                                          =}
{=          Generates code for an array reference.                          =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpArrayRef(code: PExpr);

BEGIN
    ArrayRefAddr(code);
    WITH code^ DO BEGIN
        CASE exprType^.idTyp OF
            tINT:       WriteLn(outFile,'    MOVE.W  (A0),D0');
            tREAL:      WriteLn(outFile,'    MOVE.L  (A0),D0');
            OTHERWISE   ArgSizeErr('DumpArrayRef');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPFIELDREF                                                        =}
{=                                                                          =}
{=          Generates code for a record field reference.                    =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpFieldRef(code: PExpr);

BEGIN
    FieldRefAddr(code);
    WITH code^ DO BEGIN
        CASE exprType^.idTyp OF
            tINT:       WriteLn(outFile,'    MOVE.W  (A0),D0');
            tREAL:      WriteLn(outFile,'    MOVE.L  (A0),D0');
            OTHERWISE   ArgSizeErr('DumpArrayRef');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPINTOP                                                           =}
{=                                                                          =}
{=          Generates code for an integer operation.                        =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE            The parse tree to generate code from            =}
{=          OP              The operation to be performed                   =}
{=          COMMUTATIVE     TRUE if the operation is commutative (+,-,*)    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpIntOp(code: PExpr; op: Str255; commutative: BOOLEAN);

BEGIN
    WITH code^ DO
        IF tree1^.typ=pIntConst THEN BEGIN
            DumpExpr(tree2);
            WriteLn(outFile,'    ',op,'#',tree1^.intValue,',D0');
        END
        ELSE IF (tree2^.typ=pIntConst) AND commutative THEN BEGIN
            DumpExpr(tree1);
            WriteLn(outFile,'    ',op,'#',tree2^.intValue,',D0');
        END
        ELSE BEGIN
            DumpExpr(tree2);
            WriteLn(outFile,'    MOVE.W  D0,-(A7)');
            DumpExpr(tree1);
            WriteLn(outFile,'    ',op,'(A7)+,D0');
        END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPFLOP                                                            =}
{=                                                                          =}
{=          Generates code for a binary floating point operation.           =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=          FLOP    The floating point operation to be performed            =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpFlop(code: PExpr; flop: INTEGER);

BEGIN
    WITH code^ DO BEGIN
        DumpExpr(tree1);
        WriteLn(outFile,'    MOVE.L  D0,-(A7)');
        DumpExpr(tree2);
        WriteLn(outFile,'    MOVE.W  #',flop,',D2');
        WriteLn(outFile,'    JSR     _Flop');
    END;
END;


{============================================================================}
{=                                                                          =}
{=      DUMPINTADDSUB                                                       =}
{=                                                                          =}
{=          Generates code for an addition node.                            =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=          OP      The operation to be performed                           =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpIntAddSub(code: PExpr; op: Str255);

BEGIN
    WITH code^ DO
        IF tree1^.typ=pIntConst THEN BEGIN
            DumpExpr(tree2);
            WITH tree1^ DO
                IF intValue=0 THEN
                    { adding/subtracting zero is useless }
                ELSE IF (0<intValue) AND (intValue<=8) THEN
                    WriteLn(outFile,'    ',op,'Q.W  #',intValue,',D0')
                ELSE
                    WriteLn(outFile,'    ',op,'I.W  #',intValue,',D0');
        END

        ELSE IF tree2^.typ=pIntConst THEN BEGIN
            DumpExpr(tree1);
            WITH tree2^ DO
                IF intValue=0 THEN
                    { adding/subtracting zero is useless }
                ELSE IF (0<intValue) AND (intValue<=8) THEN
                    WriteLn(outFile,'    ',op,'Q.W  #',intValue,',D0')
                ELSE
                    WriteLn(outFile,'    ',op,'I.W  #',intValue,',D0');
        END

        ELSE DumpIntOp(code,Concat(op,'.W   '),TRUE);
END;




{============================================================================}
{=                                                                          =}
{=      DUMPADD                                                             =}
{=                                                                          =}
{=          Generates code for an addition node.                            =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpAdd(code: PExpr);

CONST
    FADDS = $1000;

BEGIN
    WITH code^ DO BEGIN
        CASE exprType^.idTyp OF
            tINT:       DumpIntAddSub(code,'ADD');
            tREAL:      DumpFlop(code,FADDS);
            OTHERWISE   ArgSizeErr('DumpAdd');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPSUB                                                             =}
{=                                                                          =}
{=          Generates code for a subtraction node.                          =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpSub(code: PExpr);

CONST
    FSUBS = $1002;

BEGIN
    WITH code^ DO BEGIN
        CASE exprType^.idTyp OF
            tINT:       DumpIntAddSub(code,'SUB');
            tREAL:      DumpFlop(code,FSUBS);
            OTHERWISE   ArgSizeErr('DumpSub');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPMULT                                                            =}
{=                                                                          =}
{=          Generates code for a multiply node.                             =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpMult(code: PExpr);

CONST
    FMULS = $1004;

BEGIN
    WITH code^ DO BEGIN
        CASE exprType^.idTyp OF
            tINT:       DumpIntOp(code,'MULS    ',TRUE);
            tREAL:      DumpFlop(code,FMULS);
            OTHERWISE   ArgSizeErr('DumpMult');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPIDIV                                                            =}
{=                                                                          =}
{=          Generates code for an integer division node.                    =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpIDiv(code: PExpr);

BEGIN
    DumpIntOp(code,'DIVS    ',FALSE);
END;



{============================================================================}
{=                                                                          =}
{=      DUMPRDIV                                                            =}
{=                                                                          =}
{=          Generates code for a real number division node.                 =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpRDiv(code: PExpr);

CONST
    FDIVS = $1006;

BEGIN
    DumpFlop(code,FDIVS);
END;



{============================================================================}
{=                                                                          =}
{=      DUMPNEG                                                             =}
{=                                                                          =}
{=          Generates code for negating a number.                           =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpNeg(code: PExpr);

BEGIN
    WITH code^ DO BEGIN
        CASE exprType^.idTyp OF
            tINT:       BEGIN
                            DumpExpr(tree1);
                            WriteLn(outFile,'    NEG.W   D0');
                        END;
            tREAL:      BEGIN
                            DumpExpr(tree1);
                            WriteLn(outFile,'    JSR     _RNeg');
                        END;
            OTHERWISE   ArgSizeErr('DumpNeg');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPREALCONST                                                       =}
{=                                                                          =}
{=          Generates code for a real constant node.                        =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpRealConst(code: PExpr);

VAR
    convert:    RECORD CASE INTEGER OF
                    1:  (realPart:  Single);
                    2:  (value:     LONGINT);
                END;

BEGIN
    WITH convert DO BEGIN
        realPart := code^.realValue;
        IF value<>0 THEN IF (0<value) AND (value<=8)
            THEN WriteLn(outFile,'    MOVEQ   #',value,',D0')
            ELSE WriteLn(outFile,'    MOVE.L  #',value,',D0');
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPINTCONST                                                        =}
{=                                                                          =}
{=          Generates code for an integer constant node.                    =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpIntConst(code: PExpr);

BEGIN
    WITH code^ DO
        IF intValue<>0 THEN IF (0<intValue) AND (intValue<=8)
            THEN WriteLn(outFile,'    MOVEQ   #',intValue,',D0')
            ELSE WriteLn(outFile,'    MOVE.W  #',intValue,',D0');
END;



{============================================================================}
{=                                                                          =}
{=      DUMPREAL2INT                                                        =}
{=                                                                          =}
{=          Generates code for conversion from real to integer.             =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpReal2Int(code: PExpr);

BEGIN
    DumpExpr(code^.tree1);
    WriteLn(outFile,'    JSR     _Real2Int');
END;



{============================================================================}
{=                                                                          =}
{=      DUMPINT2REAL                                                        =}
{=                                                                          =}
{=          Generates code for integer to real.                             =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpInt2Real(code: PExpr);

BEGIN
    DumpExpr(code^.tree1);
    WriteLn(outFile,'    JSR     _Int2Real');
END;



{============================================================================}
{=                                                                          =}
{=      DUMPICMP                                                            =}
{=                                                                          =}
{=          Generates code for comparison of integers.                      =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=          TEST    The condition to test for                               =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpICmp(code: PExpr; test: Str255);

BEGIN
    WITH code^ DO BEGIN
        DumpExpr(tree2);
        WriteLn(outFile,'    MOVE.W  D0,-(A7)');
        DumpExpr(tree1);
        WriteLn(outFile,'    CMP.W   (A7)+,D0');
        WriteLn(outFile,'    S',test,'     D0');
        WriteLn(outFile,'    EXT.W   D0');
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPFCMP                                                            =}
{=                                                                          =}
{=          Generates code for comparison of real numbers.                  =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=          TEST    The condition to test for                               =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpFCmp(code: PExpr; test: Str255);

BEGIN
    WITH code^ DO BEGIN
        DumpExpr(tree1);
        WriteLn(outFile,'    MOVE.L  D0,-(A7)');
        DumpExpr(tree2);
        WriteLn(outFile,'    JSR     _FCmp');
        WriteLn(outFile,'    S',test,'     D0');
        WriteLn(outFile,'    EXT.W   D0');
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPEQ                                                              =}
{=                                                                          =}
{=          Generates code for an '=' node.                                 =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpEq(code: PExpr);

BEGIN
    WITH code^ DO BEGIN
        CASE tree1^.exprType^.idTyp OF
            tINT:       DumpICmp(code,'EQ');
            tREAL:      DumpFCmp(code,'EQ');
            OTHERWISE   ArgSizeErr('DumpEq');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPNEQ                                                             =}
{=                                                                          =}
{=          Generates code for a '<>' node.                                 =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpNeq(code: PExpr);

BEGIN
    WITH code^ DO BEGIN
        CASE tree1^.exprType^.idTyp OF
            tINT:       DumpICmp(code,'NE');
            tREAL:      DumpFCmp(code,'NE');
            OTHERWISE   ArgSizeErr('DumpNeq');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPLT                                                              =}
{=                                                                          =}
{=          Generates code for a '<' node.                                  =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpLt(code: PExpr);

BEGIN
    WITH code^ DO BEGIN
        CASE tree1^.exprType^.idTyp OF
            tINT:       DumpICmp(code,'LT');
            tREAL:      DumpFCmp(code,'LO');
            OTHERWISE   ArgSizeErr('DumpLt');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPLEQ                                                             =}
{=                                                                          =}
{=          Generates code for a '<=' node.                                 =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpLeq(code: PExpr);

BEGIN
    WITH code^ DO BEGIN
        CASE tree1^.exprType^.idTyp OF
            tINT:       DumpICmp(code,'LE');
            tREAL:      DumpFCmp(code,'LS');
            OTHERWISE   ArgSizeErr('DumpLeq');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPGT                                                              =}
{=                                                                          =}
{=          Generates code for a '>' node.                                  =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpGt(code: PExpr);

BEGIN
    WITH code^ DO BEGIN
        CASE tree1^.exprType^.idTyp OF
            tINT:       DumpICmp(code,'GT');
            tREAL:      DumpFCmp(code,'GT');
            OTHERWISE   ArgSizeErr('DumpGt');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPGEQ                                                             =}
{=                                                                          =}
{=          Generates code for a '>=' node.                                 =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpGeq(code: PExpr);

BEGIN
    WITH code^ DO BEGIN
        CASE tree1^.exprType^.idTyp OF
            tINT:       DumpICmp(code,'GE');
            tREAL:      DumpFCmp(code,'GE');
            OTHERWISE   ArgSizeErr('DumpGeq');
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPEXPR                                                            =}
{=                                                                          =}
{=          Generates code for an expression.                               =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpExpr(code: PExpr);

BEGIN
    IF code<>NIL THEN WITH code^ DO CASE typ OF
        pFuncCall:  DumpFuncCall(code);
        pVariable:  DumpVariable(code);
        pArrayRef:  DumpArrayRef(code);
        pFieldRef:  DumpFieldRef(code);
        pAdd:       DumpAdd(code);
        pSub:       DumpSub(code);
        pMult:      DumpMult(code);
        pIDiv:      DumpIDiv(code);
        pRDiv:      DumpRDiv(code);
        pNeg:       DumpNeg(code);
        pRealConst: DumpRealConst(code);
        pIntConst:  DumpIntConst(code);
        pReal2Int:  DumpReal2Int(code);
        pInt2Real:  DumpInt2Real(code);
        pEq:        DumpEq(code);
        pNeq:       DumpNeq(code);
        pLt:        DumpLt(code);
        pLeq:       DumpLeq(code);
        pGt:        DumpGt(code);
        pGeq:       DumpGeq(code);
        OTHERWISE   Error([eCod],'Unknown expression node type.');
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPASSIGN                                                          =}
{=                                                                          =}
{=          Generates code for an assignment.                               =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpAssign(code: PTree);

BEGIN
    WITH code^ DO BEGIN
        IF tree1=NIL THEN Error([eCod],'Tree1=NIL in DumpAssign.')
        ELSE BEGIN
            DumpExpr(tree2);
            CASE tree1^.exprType^.size OF
                2:          WriteLn(outFile,'    MOVE.W  D0,-(A7)');
                4:          WriteLn(outFile,'    MOVE.L  D0,-(A7)');
                OTHERWISE   ArgSizeErr('DumpAssign');
            END;
            VarAddr(tree1);
            CASE tree1^.exprType^.size OF
                2:          WriteLn(outFile,'    MOVE.W  (A7)+,(A0)');
                4:          WriteLn(outFile,'    MOVE.L  (A7)+,(A0)');
                OTHERWISE   ArgSizeErr('DumpAssign');
            END;
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPFOR                                                             =}
{=                                                                          =}
{=          Generates code for a FOR statement.                             =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpFOR(code: PTree);

VAR
    lab1,lab2:  INTEGER;
    p:          PExpr;

BEGIN
    WITH code^ DO BEGIN
        lab1 := GetLabel;
        lab2 := GetLabel;

        DumpAssign(code);

        LabelHere(lab1);

        p := NewPNode(pLeq);
        p^.tree1 := tree1;
        p^.tree2 := tree3;
        DumpExpr(p);
        Dispose(p);
        Test('EQ',lab2);

        DumpStatements(tree4);

        VarAddr(tree1);
        WriteLn(outFile,'    ADDQ.W  #1,(A0)');

        Jump(lab1);

        LabelHere(lab2);
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPWHILE                                                           =}
{=                                                                          =}
{=          Generates code for a WHILE statement.                           =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpWHILE(code: PTree);

VAR
    lab1,lab2:  INTEGER;

BEGIN
    WITH code^ DO BEGIN
        lab1 := GetLabel;
        lab2 := GetLabel;

        LabelHere(lab1);

        DumpExpr(tree1);
        Test('EQ',lab2);

        DumpStatements(tree2);

        Jump(lab1);

        LabelHere(lab2);
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPPROCCALL                                                        =}
{=                                                                          =}
{=          Generates code for a procedure call.                            =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpProcCall(code: PTree);

BEGIN
    ProcFuncCall(code);
END;



{============================================================================}
{=                                                                          =}
{=      DUMPIF                                                              =}
{=                                                                          =}
{=          Generates code for an IF statement.                             =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpIF(code: PTree);

VAR
    lab1,lab2:  INTEGER;

BEGIN
    WITH code^ DO BEGIN
        lab1 := GetLabel;
        IF tree3<>NIL THEN lab2 := GetLabel;

        DumpExpr(tree1);
        Test('EQ',lab1);

        DumpStatements(tree2);

        IF tree3=NIL THEN BEGIN
            LabelHere(lab1);
        END
        ELSE BEGIN
            Jump(lab2);
            LabelHere(lab1);
            DumpStatements(tree3);
            LabelHere(lab2);
        END;
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPINFLOOP                                                         =}
{=                                                                          =}
{=          Generates code for an infinite loop.                            =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpInfLoop(code: PTree);

VAR
    lab1:       INTEGER;

BEGIN
    WITH code^ DO BEGIN
        lab1 := GetLabel;
        LabelHere(lab1);
        DumpStatements(tree1);
        Jump(lab1);
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPSTATEMENTS                                                      =}
{=                                                                          =}
{=          Generates code from a parse tree.                               =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE    The parse tree to generate code from                    =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpStatements(code: PTree);

BEGIN
    IF code<>NIL THEN WITH code^ DO BEGIN
        CASE typ OF
            pAssign:    DumpAssign(code);
            pFOR:       DumpFOR(code);
            pWHILE:     DumpWHILE(code);
            pProcCall:  DumpProcCall(code);
            pIF:        DumpIF(code);
            pInfLoop:   DumpInfLoop(code);
            OTHERWISE   Error([eCod],'Unknown statement node type.');
        END;
        DumpStatements(next);
    END;
END;



{============================================================================}
{=                                                                          =}
{=      DUMPPROCEDURE                                                       =}
{=                                                                          =}
{=          Generates the code for a procedure.                             =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          CODE        The parse tree for the procedure                    =}
{=          PROCPTR     A pointer to the procedure's symbol table entry     =}
{=                                                                          =}
{============================================================================}

PROCEDURE DumpProcedure(code: PTree; procPtr: SymPtr);

BEGIN
    WITH procPtr^ DO
        IF parent=NIL THEN procLevel := 0
                      ELSE procLevel := parent^.level;
    ProcEntry(procPtr);
    DumpStatements(code);
    ProcExit(procPtr);
END;

END.