{============================================================================}
{=                                                                          =}
{=      'Error.Pas'                                                         =}
{=                                                                          =}
{=          Pascal compiler error message routines.                         =}
{=                                                                          =}
{=              11/30/86 - Bruce Tomlin                                     =}
{=                                                                          =}
{============================================================================}

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

UNIT Error;

INTERFACE

USES
    MacDefs,
    Files;

TYPE
    ErrType =   (eLex,eSyn,eSem,eCod,eFatal);
    ErrSet =    SET OF ErrType;

VAR
    { 'linePos' and 'readLine' are also used 'GetSym' }

    linePos:    INTEGER;    { Current position in 'readLine' }
    readLine:   Str255;     { Current line being scanned }

PROCEDURE Pause;
PROCEDURE Wait;
PROCEDURE ExitCompiler;
PROCEDURE Error(errTyp: ErrSet; msg: Str255);



IMPLEMENTATION

CONST
    tab = 9;        { ASCII code for tab character }



{============================================================================}
{=                                                                          =}
{=      PAUSE                                                               =}
{=                                                                          =}
{=          Allows the user to pause compilation by holding the mouse       =}
{=      button down.                                                        =}
{=                                                                          =}
{============================================================================}

PROCEDURE Pause;

BEGIN
    WHILE Button DO;
END;



{============================================================================}
{=                                                                          =}
{=      WAIT                                                                =}
{=                                                                          =}
{=          Wait for the user to click the mouse button or to press a key.  =}
{=                                                                          =}
{============================================================================}

PROCEDURE Wait;

VAR
    theEvent:   EventRecord;

BEGIN
    { Tell the user how to go on }

    Write(screen,'Click mouse button to continueÉ');

    { Get rid of any mouse clicks or keypresses in the event queue }

    FlushEvents(everyEvent-diskMask,0);

    { Wait for a key or a click }

    WHILE NOT GetNextEvent(keyDownMask+mDownMask,theEvent) DO;
END;



{============================================================================}
{=                                                                          =}
{=      EXITCOMPILER                                                        =}
{=                                                                          =}
{=          Prints the hashing statistics, closes all open files, waits for =}
{=      the user to press a key or click the mouse button, and then exits   =}
{=      to the operating system.                                            =}
{=                                                                          =}
{============================================================================}

PROCEDURE ExitCompiler;

BEGIN
    { Close the input and output files }

    Close(inFile);
    IF NOT screenOut THEN Close(outFile);

    { Wait for a key or a click }

    Wait;

    { Exit to the operating system }

    ExitToShell;
END;



{============================================================================}
{=                                                                          =}
{=      ERROR                                                               =}
{=                                                                          =}
{=          Prints an error message.                                        =}
{=                                                                          =}
{=      Parameters:                                                         =}
{=                                                                          =}
{=          ERRTYP      A set indicating the type of error                  =}
{=          MSG         The error message                                   =}
{=                                                                          =}
{============================================================================}

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

VAR
    i:      INTEGER;

BEGIN
    IF NOT (eFatal IN errTyp) THEN BEGIN

        { If the error was not fatal, print an arrow under the error }

        WriteLn(screen,readLine);

        FOR i := 3 TO linePos DO
            IF readLine[i]=CHR(tab) THEN Write(screen,CHR(tab))
                                    ELSE Write(screen,' ');
        WriteLn(screen,'^');

        { If output is to a listing file, print it there, too. }

        IF NOT screenOut THEN BEGIN
            Write(outFile,'; ');
            FOR i := 3 TO linePos DO
                IF readLine[i]=CHR(tab) THEN Write(outFile,CHR(tab))
                                        ELSE Write(outFile,' ');
            WriteLn(outFile,'^');
        END;

    END;

    { Print the error message and the error type, if specified }

    Write(screen,'**** ');

    IF eLex IN errTyp THEN Write(screen,'Lexical:  ');
    IF eSyn IN errTyp THEN Write(screen,'Syntax:  ');
    IF eSem IN errTyp THEN Write(screen,'Semantic:  ');
    IF eCod IN errTyp THEN Write(screen,'Code gen:  ');

    WriteLn(screen,msg,' ****');

    { If output is to a listing file, print it there, too. }

    IF NOT screenOut THEN BEGIN
        Write(outFile,'; **** ');

        IF eLex IN errTyp THEN Write(outFile,'Lexical:  ');
        IF eSyn IN errTyp THEN Write(outFile,'Syntax:  ');
        IF eSem IN errTyp THEN Write(outFile,'Semantic:  ');
        IF eCod IN errTyp THEN Write(outFile,'Code gen:  ');

        WriteLn(outFile,msg,' ****');
    END;

    { Abort if fatal error }

    IF eFatal IN errTyp THEN BEGIN

        { Beep to get the user's attention }

        SysBeep(8);
        SysBeep(8);
        SysBeep(8);

        { Exit from the compiler. }

        ExitCompiler;
    END;

    { Beep to get the user's attention }

    SysBeep(8);
END;

END.