(****************************************
*                                       *
*     MODULA-2 Multi-Pass Compiler      *
*     ****************************      *
*                                       *
*       VAX/VMS Implementation          *
*                                       *
*                                       *
*     MVCListing:                       *
*                                       * 
*     Listing generation                *
*                                       * 
*     Version 3.1 of  1-FEB-1983        *
*                                       *
*                                       *
*                                       *
*                                       *
*     Based on PDP11 Implementation:    *
*     Version M22 of 26.02.81           *
*                                       *
*     Institut fuer Informatik          *
*     ETH-Zuerich                       *
*     CH-8092 Zuerich                   *
*                                       *
****************************************)

(****************************************
* Updates:                              *
* - - - - - - - - - - - - - - - - - - - *
* No.  1 of                             *
****************************************)

IMPLEMENTATION MODULE MVCListing; (* PDP: LG *)
                                  (* VAX: M. Mall, P. Putfarken, H.Eckhardt *)
  (* $T- *)

  IMPORT MVCompiler, MVCPublic, MVCErrors, MVCXRef, MVCMonitor,
         SYSTEM, VMS, RMS,
         FileSystem, Terminal, Measures, Conversions, DateTime,
         CommonInputOutputProcedures;


  CONST
    TAB =       11C;

(* - - - - - - - - - - - - - - - - - - - *)

  MODULE NameSystem;

    FROM MVCompiler     IMPORT Spellix, spelltab;

    EXPORT      SetSpell, ReadSpell;

    VAR
      spellpos :        Spellix;


    PROCEDURE SetSpell ( id : Spellix );
        (* Set up NameSystem for reading spelltab at id *)

    BEGIN
      spellpos := id;
    END SetSpell;

    PROCEDURE ReadSpell ( VAR ch : CHAR );
        (* Read next character from spelltab *)

    BEGIN
      ch := spelltab [ spellpos ];
      IF ch <> ' ' THEN INC ( spellpos ) (* else end of name *) END;
    END ReadSpell;

    BEGIN (* NameSystem init *)
      spellpos := 0;
    END NameSystem;

(* - - - - - - - - - - - - - - - - - - - *)

  MODULE ErrorSystem;

    FROM MVCErrors      IMPORT GetError;
    FROM Terminal       IMPORT Write, WriteString, WriteLn;
    FROM Lister         IMPORT ListChar, ListString, ListLn;
    FROM Printers       IMPORT currline;
    IMPORT TAB;

    EXPORT      errline, freepos, errcount, StartErrors, OutErrors,
                OutErrChar, OutErrString, OutErrLn;
    VAR
      errline : CARDINAL;
      pos : CARDINAL;
      freepos : CARDINAL;
      errcount : CARDINAL;
      buffer: ARRAY [0..79] OF CHAR;
      mark :  ARRAY [0..5] OF CHAR;


    PROCEDURE OutErrChar ( ch : CHAR );

    BEGIN
      Write ( ch );
      ListChar ( ch );
      INC ( freepos );
    END OutErrChar;

    PROCEDURE OutErrString ( s : ARRAY OF CHAR );

        PROCEDURE positions ( s : ARRAY OF CHAR ) : CARDINAL;
        VAR
                i :     CARDINAL;
        BEGIN
          FOR i := HIGH ( s ) TO 0 BY -1 DO
            IF s [ i ] <> 0C THEN RETURN i+1 END;
          END;
          RETURN 0;
        END positions;

    BEGIN
      WriteString ( s );
      ListString ( s, 0 );
      INC ( freepos, positions ( s ));
    END OutErrString;

    PROCEDURE OutErrLn;

    BEGIN
      WriteLn;
      ListLn;
    END OutErrLn;


    PROCEDURE StartErrors;

    BEGIN
      GetError(errline, pos, buffer);
    END StartErrors;

    PROCEDURE OutErrors;

      VAR
        lastpos : CARDINAL;

    BEGIN
      lastpos := 0;
      OutErrString( mark );
      freepos := 1;
      WHILE errline = currline DO
        IF (pos > 0) & (pos = lastpos) THEN
          OutErrChar(',');
        ELSE 
          IF freepos > pos THEN
            OutErrLn;
            OutErrString( mark );
            freepos := 1;
          END;
          WHILE freepos < pos DO
            OutErrChar(' ')
          END;
          OutErrChar('^');
          lastpos := pos;
        END;
        OutErrChar(' ');
        OutErrString(buffer);
        INC(errcount);
        GetError(errline,pos,buffer);
      END; (* WHILE *)
      OutErrLn;
    END OutErrors;

  BEGIN
    errcount := 0;
    mark := ' ****';
    mark[5] := TAB;
  END ErrorSystem;

(* - - - - - - - - - - - - - - - - - - - *)

  MODULE Lister;

  FROM MVCompiler       IMPORT mainmodp;
  FROM MVCPublic        IMPORT MVCompilerVersion, modFile, source, lstFile,
                               comptime, Compilerstatus, compstat;
  FROM VMS              IMPORT SYS$DISPLAY;
  FROM RMS              IMPORT FABptr, XABDAT, InitXabDat;
  FROM SYSTEM           IMPORT ADR;
  FROM FileSystem       IMPORT WriteRecord, Fab;
  FROM Conversions      IMPORT CardToString;
  FROM DateTime         IMPORT ConvertTime;
  FROM CommonInputOutputProcedures IMPORT LIB$LP_LINES;
  FROM NameSystem       IMPORT SetSpell, ReadSpell;

  EXPORT        ListChar, ListString, ListLn, ListPage,
                TestPage, Subtitle, StartLister;


  CONST
        LineFeed =      12C;
        FormFeed =      14C;
        LineBufSize =   132;

  VAR
        listOn :        BOOLEAN;
        maxTextlines :  CARDINAL;
        PageNo :        CARDINAL;
        Textline :      CARDINAL;               (* no. of textline   *)
        LineBuf :       ARRAY [0..LineBufSize-1] OF CHAR;
        LineBufIx :     CARDINAL;               (* Line buffer index *)

        Header :        RECORD (* with structural conversion *)
                        CASE BOOLEAN OF
                          FALSE:
                            Feed :      CHAR;
                            MainName :  ARRAY [0..59] OF CHAR;
                            CompDate :  ARRAY [0..24] OF CHAR;
                            MVCVersion: ARRAY [0..34] OF CHAR;
                            PageMark :  ARRAY [0.. 3] OF CHAR;
                            Pageno :    ARRAY [0.. 3] OF CHAR;|
                          TRUE:
                            Line :      ARRAY [0..128] OF CHAR
                        END;
                        END;

        SubHeader :     RECORD (* with structural conversion *)
                        CASE BOOLEAN OF
                          FALSE:
                            Subject :   ARRAY [0..59] OF CHAR;
                            SourceDate: ARRAY [0..24] OF CHAR;
                            SourceName: ARRAY [0..44] OF CHAR;
                            Feed :      CHAR;|
                          TRUE:
                            Line :      ARRAY [0..130] OF CHAR
                        END;
                        END;



  PROCEDURE ListChar ( ch : CHAR );

  BEGIN
   IF listOn THEN
    IF ch = FormFeed THEN
      ListPage;
    ELSE
      IF LineBufIx >= LineBufSize THEN ListLn END;
      LineBuf [ LineBufIx ] := ch;
      INC ( LineBufIx );
    END;
   END (* if listOn *);
  END ListChar;


  PROCEDURE ListString ( s : ARRAY OF CHAR; length : CARDINAL );
        (* Lists the string s.
         * length > 0: the output is confined to length places;
         *         if s is longer, the string is cut,
         *         otherwise it is filled up with blanks.
         *)

  VAR
        limit : CARDINAL;
        i :     CARDINAL;
        ch :    CHAR;

  BEGIN
   IF listOn THEN
    limit := HIGH ( s );
    IF (length > 0) & (limit >= length) THEN
      limit := length - 1;
    END;
    i := 0;
    LOOP
      IF i > limit THEN EXIT END;
      ch := s [ i ];
      IF ch = 0C THEN EXIT END;
      ListChar ( ch ); INC ( i );
    END;
    WHILE i < length DO
      ListChar ( ' ' ); INC ( i );
    END;
   END (* if listON *);
  END ListString;


  PROCEDURE ListLn;

  BEGIN
   IF listOn THEN
    IF Textline >= maxTextlines THEN
      Page;
    END;
    IF LineBufIx > 0 THEN
      (* something is in the buffer *)
      WriteRecord ( lstFile, LineBuf, LineBufIx );
      LineBufIx := 0;
    ELSE
      WriteRecord ( lstFile, LineBuf, 0 );
    END;
    INC ( Textline );
   END (* if listOn *);
  END ListLn;


  PROCEDURE Page;
        (* New listing page, called internally
         * without clearing the line buffer.
         * Form feed suppressed on first page.
         *)

  VAR
        size :  CARDINAL;

  BEGIN
    INC ( PageNo );
    CardToString ( PageNo, 4, Header.Pageno );
    size := HIGH ( Header.Line ) + 1;
    WriteRecord  ( lstFile, Header.Line, size );
    size := HIGH ( SubHeader.Line ) + 1;
    WriteRecord  ( lstFile, SubHeader.Line, size );
    Textline := 0;
    IF PageNo = 1 THEN
      Header.Feed := FormFeed;
    END;
  END Page;


  PROCEDURE ListPage;
        (* New listing page, exported procedure.
         *)

  BEGIN
   IF listOn THEN
    IF LineBufIx > 0 THEN (* clear buffer *)
      WriteRecord (lstFile, LineBuf, LineBufIx );
      LineBufIx := 0;
    END;
    Page;
   END (* if listOn *);
  END ListPage;


  PROCEDURE TestPage ( lines : CARDINAL );
        (* A call to ListPage is executed if
         * the number of textlines remaining on
         * the page is < lines.
         *)

  BEGIN
    IF (Textline + lines) > maxTextlines THEN
      ListPage;
    END;
  END TestPage;


  PROCEDURE FillInString (VAR targ : ARRAY OF CHAR; sourc : ARRAY OF CHAR );

  VAR
        i  :            CARDINAL;
        limit1 :        CARDINAL;
        limit2 :        CARDINAL;

  BEGIN
    limit1 := HIGH ( targ );
    limit2 := HIGH ( sourc );
    FOR i := 0 TO limit1 DO
      targ [ i ] := ' ';
    END;
    i := 0;
    LOOP
      IF sourc [ i ] = 0C THEN EXIT END;
      targ [ i ] := sourc [ i ];
      INC ( i );
      IF (i > limit1) OR (i > limit2) THEN EXIT END;
    END;
  END FillInString;


  PROCEDURE Subtitle ( subtitle : ARRAY OF CHAR );

  BEGIN
    FillInString ( SubHeader.Subject, subtitle );
  END Subtitle;


  PROCEDURE StartLister;
        (* Initialize page header lines and numbering
         *)

  VAR
        Names :         ARRAY [0..59] OF CHAR;
        Dates :         ARRAY [0..19] OF CHAR;
        XabDat :        XABDAT;
        fab :           FABptr;
        ix1, ix2 :      CARDINAL;
        spec :          ARRAY [0..24] OF CHAR;
        ch :            CHAR;

  BEGIN
    listOn := listings IN compstat;
    IF listOn THEN
      (* get module name: *)
      ix2 := 0;
      SetSpell ( mainmodp^.name );
      ReadSpell ( ch );
        WHILE ch <> ' ' DO
          Names[ix2] := ch;
          INC(ix2);
          ReadSpell ( ch );
        END;
        IF defs IN compstat THEN
          WITH mainmodp^ DO
            (* assuming klass = mods: *)
            IF (* globalmodule and .. *) foreign THEN
              spec := ' (%FOREIGN Definition)';
            ELSE
              spec :=   ' (Definition)';
            END (* if *);
          END (* with *);
          FOR ix1 := 0 TO HIGH(spec) DO
            Names[ix2] := spec[ix1];
            INC(ix2);
          END
        END;
      Names[ix2] := 0C;
      WITH Header DO
        Feed := 0C;
        FillInString ( MainName, Names );
        ConvertTime ( comptime, Dates );
        FillInString ( CompDate, Dates );
        FillInString ( MVCVersion, MVCompilerVersion );
        PageMark := 'Page';
      END (* with Header *);
      (* get source file creation date: *)
      InitXabDat ( XabDat );
      fab := Fab(modFile);
      WITH fab^ DO
        XAB := ADR ( XabDat );
      END;
      IF NOT ODD ( SYS$DISPLAY (fab, 0, 0 )) THEN
        Dates := '***********';
      ELSE
        ConvertTime ( XabDat.CDT, Dates );
      END;
      WITH SubHeader DO
        FillInString ( SourceDate, Dates );
        FillInString ( SourceName, source );
        Feed := LineFeed;
      END (* with SubHeader *);
      PageNo := 0;
    END (* if listOn *);
  END StartLister;


  BEGIN (* Lister *)
    LineBufIx := 0;
    listOn := FALSE;
    maxTextlines := LIB$LP_LINES() - 3 (* headlines *);
      IF maxTextlines > 60 THEN
        maxTextlines := 60
      END;
  END Lister;

(* - - - - - - - - - - - - - - - - - - - *)

  MODULE Printers;

  FROM MVCompiler       IMPORT Idclass, Idset, Varkind,
                               Structform, XRefptr, Spellix, sysmodp;
  FROM MVCPublic        IMPORT Compilerstatus, Statset, compstat,
                               InterInFile, optStrings,
                               modFile, lstFile, symFile, objFile;
  FROM MVCXRef          IMPORT Nameptr, StLabel, XTabEntry,
                               OpenTable, GetEntry, EoTab;
  FROM MVCMonitor       IMPORT MonitEntries, StopMonitorValues, GetMonitorValues;
  FROM FileSystem       IMPORT Name, Reset, Eof, ReadRecord;
  FROM Conversions      IMPORT NumToString, CardToString;
  FROM NameSystem       IMPORT SetSpell, ReadSpell;
  FROM ErrorSystem      IMPORT errline, errcount, OutErrChar, OutErrString,
                               OutErrLn, OutErrors, StartErrors;
  FROM Lister           IMPORT ListChar, ListString, ListLn, ListPage,
                               TestPage, Subtitle, StartLister;
  IMPORT TAB;

  EXPORT        currline,
                PrintSourceListing, PrintCrossListing, PrintCodeListing,
                PrintEpilogue;

  VAR
        currline :      CARDINAL;


    PROCEDURE PrintSourceListing;
        (* Copies source file to listing file,
         * with error messages inserted.
         *)

        PROCEDURE ReadSourceLn ( VAR sline : ARRAY OF CHAR );
          VAR   size : CARDINAL;
        BEGIN
          size := HIGH ( sline ) + 1;
          ReadRecord ( modFile, sline, size );
          IF size <= HIGH ( sline ) THEN sline [ size ] := 0C END;
        END ReadSourceLn;

      VAR
        buf: RECORD
               CASE BOOLEAN OF
                 FALSE: lit : ARRAY [0..4] OF CHAR;
                        tab : CHAR;
                        lin : ARRAY [0..131-8] OF CHAR; |
                 TRUE:  line: ARRAY [0..131-8+6] OF CHAR
               END;
             END;

    BEGIN
      Reset(modFile);
      Subtitle ( 'Source Listing' );
      ListPage;
      StartErrors;
      buf.tab := TAB;
      currline := 0;
      ReadSourceLn ( buf.lin );
      WHILE NOT Eof(modFile) DO
        INC(currline);
        CardToString ( currline, 5, buf.lit );
        IF currline = errline THEN
          OutErrString ( buf.line );
          OutErrLn;
          OutErrors
        ELSE
          ListString ( buf.line, 0 );
          ListLn;
        END;
        ReadSourceLn ( buf.lin );
      END; (* WHILE *)
      IF errline > 0 THEN (* further error messages *)
        IF errcount > 0  THEN OutErrString ('further ') END;
        OutErrString('errors: ');
        OutErrLn;
        WHILE errline > 0 DO
          currline := errline;
          OutErrors
        END;
      END;
      ListLn;
        IF compstat * Statset{globerrs, symerrs} = Statset{} THEN
          ListString ('NO', 0)
        ELSIF errcount > 0 THEN
          CardToString(errcount, 3, buf.lit);
          ListString(buf.lit, 0);
        END;
      ListString(' ERROR', 0);
      IF errcount <> 1 THEN ListChar ('S') END;
      ListString(' encountered', 0);
      ListLn;
    END PrintSourceListing;


    PROCEDURE PrintCrossListing;

    CONST
        lineLength =    132;
        colWidth =        6;
        colsperline =   (lineLength - 16 (* 2 TABs *)) DIV colWidth;

    VAR
        entry :         XTabEntry;
        lastC :         CHAR;

      PROCEDURE Capitalize ( VAR ch : CHAR );

        BEGIN
          IF (ch >= 'a') AND (ch <= 'z') THEN ch := CAP ( ch ) END;
        END Capitalize;

      PROCEDURE Name ( id : Spellix; VAR length : CARDINAL );
        (* list a name from spelltab *)
        (* and count its length      *)

        VAR
          ch :  CHAR;

        BEGIN
          length := 0;
          SetSpell ( id );
          ReadSpell ( ch );
          WHILE ch <> ' ' DO
            INC ( length );
            ListChar ( ch );
            ReadSpell ( ch );
          END;
        END Name;

      PROCEDURE NameScopes ( namep : Nameptr );

        VAR
          dummy : CARDINAL;
        BEGIN
          LOOP
            Name ( namep^.name, dummy );
            namep := namep^.next;
            IF namep = NIL THEN
              EXIT
            END;
            ListString (' / ', 0);
          END;
        END NameScopes;

      PROCEDURE Label;
        (* prints type/structure information of current XTabEntry *)

        VAR
          length : CARDINAL;
          ch :     CHAR; (* auxiliary *)

        PROCEDURE DisplayStruct;
          (* prints structure information of current XTabEntry *)

          BEGIN
            WITH entry DO
              IF scopes <> NIL THEN
                IF (scopes^.name = sysmodp^.name) OR
                   (NOT struct.named AND (struct.typeform = hides)) THEN
                  (* don't display hidden or SYSTEM structures: *)
                  RETURN
                END;
              END;
              ListString ( ' < ', 0);
              IF struct.named THEN
                Name ( struct.typename, length );
              ELSE
                CASE struct.typeform OF
                  enums :  ListString ( '[enumeration]', 0) |
                  bools :  ListString ( 'BOOLEAN', 0) |
                  chars :  ListString ( 'CHAR', 0) |
                  ints :   ListString ( 'INTEGER', 0) |
                  cards :  ListString ( 'CARDINAL', 0) |
                  reals :  ListString ( 'REAL', 0) |
                  pointers:ListString ( 'POINTER', 0);
                           IF elstruct.named THEN
                             ListString (' TO ', 0);
                             Name ( elstruct.typename, length );
                           END |
                  sets :   ListString ( 'SET', 0);
                           IF elstruct.named THEN
                             ListString (' OF ', 0);
                             Name ( elstruct.typename, length );
                           END |
                  arrays : ListString ( 'ARRAY', 0);
                           IF elstruct.named THEN
                             ListString (' [..] OF ', 0);
                             Name ( elstruct.typename, length );
                           END |
                  records: ListString ( 'RECORD', 0);
                ELSE
                  (* remaining Structforms have been replaced *)
                END (* case typeform *);
              END (* if isnamed *);
            END (* with entry *);
            ListString (' >', 0);
          END DisplayStruct;

        BEGIN (* Label *)
          WITH entry DO
            (* empty line when new char in alphabet: *)
            SetSpell ( ident );
            ReadSpell ( ch );
            Capitalize ( ch );
            IF ch <> lastC THEN
              ListLn;
              lastC := ch;
            END;
            TestPage ( 3 );
            ListLn;
            Name ( ident, length );
            ListString (': ', 0);
            (* alignement: *)
            IF length < 14 THEN
              ListString (' ', 14-length)
            ELSIF length > 14 THEN
              ListChar ( TAB )
            END;
              CASE class OF
                consts :  ListString ( 'constant', 10);
                          DisplayStruct |
                types : ListString ( 'type', 10);
                        DisplayStruct |
                vars :  IF kind = noparam THEN
                          ListString ( 'variable', 10)
                        ELSE
                          ListString ( 'parameter ', 10);
                          IF kind = valparam THEN
                            ListString ( ' (value)', 12)
                          ELSE
                            ListString ( ' (variable)', 12)
                          END;
                        END (* if kind = noparam *);
                        DisplayStruct |
                fields: ListString ( 'field ', 10);
                        DisplayStruct |
                pures : ListString ( 'procedure', 10) |
                funcs : ListString ( 'function', 10);
                        DisplayStruct |
                mods :  ListString ( 'module', 0);
              ELSE
              END;
              IF external AND (class <> fields) THEN
                IF class = mods THEN
                  ListString (', imported', 0)
                ELSIF scopes <> NIL THEN
                  ListString (' from ', 0);
                  NameScopes ( scopes );
                END
              ELSIF scopes <> NIL THEN
                ListString (' in ', 0);
                NameScopes ( scopes )
              END (* if external ... else *);
              IF exported THEN
                ListString (', exported', 0)
              END;
          END (* with entry *);
        END Label;

      PROCEDURE RefList ( refhead : XRefptr );
        (* prints list of lines references *)

        VAR
          colno :       CARDINAL;
          literal :             ARRAY [0..colWidth-2] OF CHAR;

        PROCEDURE NewLine;

          BEGIN
            ListLn;
            ListChar ( TAB );
            ListChar ( TAB );
          END NewLine;

        BEGIN
          colno := 0;
          WHILE refhead <> NIL DO
            IF (colno MOD colsperline) = 0 THEN
              NewLine;
              colno := 0;
            END (* if *);
            CardToString ( refhead^.lineno, colWidth-1, literal );
            ListString ( literal, 0);
            IF refhead^.mark THEN
              ListChar ('*')
            ELSE
              ListChar (' ')
            END;
            refhead := refhead^.nextref;
            INC ( colno );
          END (* while ref <> nil *);
        END RefList;


    BEGIN (* PrintCrossListing *)
      IF crossrefs IN compstat THEN
        Subtitle ( 'Cross Reference Table' );
        ListPage;
        OpenTable;
        WHILE NOT EoTab() DO
          GetEntry ( entry );
          Label;
          RefList ( entry.refList );
        END (* while *);
        ListLn;
      END (* if crossrefs *);
    END PrintCrossListing;


    PROCEDURE PrintCodeListing;
        (* Copies interfile from pass 4,
         * containing readable code listing.
         *)

    VAR
        buf:    ARRAY [0..131] OF CHAR;
        size:   CARDINAL;

    BEGIN (* copy interfile from pass4 *)
      IF machinecodes IN compstat THEN
        Subtitle ( 'Machine Code' );
        ListPage;
        size := 132;
        ReadRecord ( InterInFile, buf, size );
          WHILE NOT Eof ( InterInFile ) DO
            ListString ( buf, size );
            ListLn;
            size := 132;
            ReadRecord ( InterInFile, buf, size );
          END;
        ListLn;
      END;
    END PrintCodeListing;


    PROCEDURE PrintEpilogue;

        PROCEDURE ListRTime (t: CARDINAL);
          (* Writes a string of 12 char's into lstFile,
           * expressing t in hours, min, &c.
           * t must count the time in 10 msec steps
           *)

        VAR
                literal :       ARRAY [0..2] OF CHAR;

        BEGIN
          CardToString (t DIV 360000 (* = hours *), 3, literal);
          ListString (literal, 0); ListChar (':');
          t   := t MOD 360000;
          NumToString (t DIV 6000 (* = minutes *), 2, 10, literal);
          ListString (literal, 0); ListChar (':');
          t   := t MOD 6000;
          NumToString (t DIV 100 (* = seconds *), 2, 10, literal);
          ListString (literal, 0); ListChar ('.');
          NumToString (t MOD 100 (* = 10-msec *), 2, 10, literal);
          ListString (literal, 0);
        END ListRTime;

        PROCEDURE ListOption( cstat : Compilerstatus );

        VAR
          fileName : ARRAY [0..59] OF CHAR;

        BEGIN
          ListString('   /', 0);
            IF NOT (cstat IN compstat) THEN
              ListString('NO', 0)
            END;
          ListString( optStrings[cstat], 0 );
          IF cstat IN (compstat * Statset{ listings, objects, symfiles }) THEN
            CASE cstat OF
              listings : Name ( lstFile, fileName ) |
              objects :  Name ( objFile, fileName ) |
              symfiles : Name ( symFile, fileName )
            END;
            ListChar ('=');
            ListString ( fileName, 0);
          END (* if cstat *);
        END ListOption;

    CONST
        HeaderLen =     25;

    VAR
        passHeader :    ARRAY [0..HeaderLen-1] OF CHAR;
        passCPU :       CARDINAL;
        dummyBufIO :    CARDINAL;
        dummyDirIO :    CARDINAL;
        passPagflt :    CARDINAL;
        TotalCPU :      CARDINAL;
        literal :               ARRAY [0..9] OF CHAR;

    BEGIN (* PrintEpilogue *)
      IF listings IN compstat THEN
        StopMonitorValues( 'Listing generation' );
        (* because the MVCPublic call to StopMonitorValues    *)
        (* has not been executed yet!                         *)
        Subtitle ( 'Compilation Summary' );
        ListLn; ListLn; ListLn;
        TestPage ( 5 );
        ListString('Active Options at End of Compilation:', 0);
        ListLn;
        ListOption( checks       );
        ListOption( debugs       ); ListLn;
        ListOption( listings     );
        ListOption( crossrefs    );
        ListOption( machinecodes ); ListLn;
        ListOption( objects      ); ListLn;
        ListOption( symfiles     ); ListLn;
        ListLn;
        TestPage ( MonitEntries+3 );
        ListString ('Performance Indicators:', 32);
        ListString ('CPU Time   Page Faults', 0); ListLn;
        TotalCPU := 0;
          WHILE MonitEntries > 0 DO
            GetMonitorValues (passHeader, passCPU, dummyBufIO, dummyDirIO, passPagflt );
            ListString ('   ', 0);
            ListString (passHeader, 25);
            INC (TotalCPU, passCPU);
            ListRTime (passCPU);
            CardToString (passPagflt, 10, literal);
            ListString ('    ', 0);
            ListString (literal, 0);
            ListLn;
          END (* while *);
        ListLn;
        ListString ('Total run time: ', 0);
        ListRTime (TotalCPU);
        CardToString ((currline * 6000) DIV TotalCPU, 3, literal);
        ListString ('   (', 0);
        ListString (literal, 0);
        ListString (' lines/minute)', 0);
        ListLn;
      END (* if listings in compstat *);
    END PrintEpilogue;

  END Printers;

(* - - - - - - - - - - - - - - - - - - - *)

  PROCEDURE Listing;

  BEGIN
    StartLister;
    PrintSourceListing;
    PrintCrossListing;
    PrintCodeListing;
    PrintEpilogue;
  END Listing;

END MVCListing.