{

                           MODULE 5
 
 
                         Source Input
                             and
                      Listing Generation
 
 
 
 
 
 Source input and listing generation are implemented by the follow-
 ing procedures:-
 
 Nextch     This procedure reads the next source character from the
            source  file, copies it to the listing file, and leaves
            its value in the global variable Ch.   A  corresponding
            value representing the position of the character in the
            source text is left in  the  variable  Source.Position.
            The  analyser may copy and use this value in subsequent
            error reporting.  Each end-of-line is transmitted as  a
            blank  character,  but  the  function LineEnded returns
            true at this time, and false at all others.
 
 Error      This procedure enables the analysis process  to  record
            error  codes  for  incorporation in the output listing.
            Each error is reported using a numeric error code and a
            source text position obtained as explained above.
 
 StartError Some errors apply to a segment of source  text,  rather
            than  a  single point. The procedure StartError is used
            to indicate the start of such a segment. The segment is
            assumed  to  extend up to the next error point reported
            via Error.
 
 Initialization of the listing generation variables is carried  out
 by  the  procedure  InitListing,  which is called before the first
 call to Nextch. Finalisation  is  carried  out  by  the  procedure
 EndListing which is called after analysis is complete.
 
 The complete interface between the source-handler and the analyser
 thus comprises the following globals:
 
 
    type ErrorSpan = 0..maxcode;
 
         TextPosition = ....;
 
    var ch : char ;
 
        Source: record
                  Position: TextPosition;
                  ....
                end;
    procedure Nextch ;
 
    function LineEnded : Boolean ;
 
    procedure Error (ErrorCode: ErrorSpan;
                     ErrorPosition: TextPosition);
 
    procedure StartError (StartPosition: TextPosition);
 
    procedure InitListing ;
 
    procedure EndListing ;

                                                                     }

program SourceHandler;

#include "globals.x"
#include "fileio.pf"
#include "options.pf"
#include "main.pf"


{

 
 5.1 Listing Pagination
 
 The following procedures are responsible for building  the  banner
 heading  and  paginating  the listing. The banner heading contains
 date, time, heading, and sub-heading fields, and the  current  set
 of  globally  selected  options. The sub-heading is user updatable
 and may be changed either by the -h UNIX option, or by the  embed-
 ded  directive ***HEADING. A global variable PageLayout is used to
 record the current values of the fields, and to maintain a running
 record of the lines remaining on the current page.
 
 The listing is paginated on the basis  of  a  two-line  banner,  a
 two-line  spacer,  and a page-depth set from the value of the con-
 stant LinesPerPage. On the Perq, no form-feed character  is  used,
 and a fixed screen or window-width of 80 characters is assumed.

                                                                     }

procedure ResetTitle(var Title: BannerString; String: ArgString);

  var i: BannerPositions;

  begin
    for i := 1 to BannerTitleSize do
      Title[i] := String[i]
  end { SetSubHeading };

procedure BuildBanner(OptionSet: SetOfOptions);

  var ChPos: BannerPositions;

  procedure SetBlank(var OpString: BannerString);

    var Next: BannerPositions;

    begin
      for Next := 1 to BannerTitleSize do OpString[Next] := ' '
    end { setblank };

  procedure Enter(SubString: OptionString; var ToString: BannerString);

    var
      i: OptionIndex;
      c: char;

    begin
      for i := 1 to OptionSize do
        begin
          c := SubString[i];
          if c <> ' '
          then
            begin
              ToString[ChPos] := c;
              ChPos := (ChPos mod BannerTitleSize) + 1
            end
        end
    end { enter };

  procedure EnterCh(c: char; var ToString: BannerString);

    begin
      ToString[ChPos] := c;
      ChPos := ChPos + 1
    end { enterch };

  procedure Punctuate(var ToString: BannerString);

    begin EnterCh(',', ToString) end { punctuate };

  procedure EnterBoolOps;

    var Option: BoolOptions;
        First: Boolean;

    begin
      with PageLayout do
        begin
          SetBlank(BoolOps);
          ChPos := 1 ;
          First := true;
          EnterCh('[', BoolOps);
          for Option := Checks to PMDump do
            if Option in OptionSet
            then
              begin
                if not First then Punctuate(BoolOps);
                Enter(OptionMap[Option].Name, BoolOps);
                First := false
              end;
          EnterCh(']', BoolOps)
        end
    end { enterboolops };

  procedure EnterIntOps;

    var
      Option: IntOptions;
      DigitString: OptionString;

    procedure IntDigits(Velue: Scalar; var Digits: OptionString);

      var
        Convert: text;
        d: OptionIndex;

      begin
        rewrite(Convert);
        write(Convert, Velue: 1);
        reset(Convert);
        Digits := '            ';
        for d := 1 to OptionSize do
          begin
            Digits[d] := Convert^;
            if not eoln(Convert) then get(Convert)
          end
      end { intdigits };

    begin
      with PageLayout do
        begin
          SetBlank(IntOps);
          ChPos := 1;
          EnterCh('[', IntOps);
          for Option := Level to Level do
            case Option of
              Level :
                begin
                  Enter('LEVEL=      ', IntOps);
                  case OptionValue[Level] of
                    Level0 : EnterCh('0', IntOps);
                    Level1 : EnterCh('1', IntOps);
                    Level2 : EnterCh('2', IntOps);
                    Level3 : EnterCh('3', IntOps)
                  end
                end;
              Margin :
                begin
                  Punctuate(IntOps);
                  Enter('MARGIN=     ', IntOps);
                  IntDigits(OptionValue[Margin], DigitString);
                  Enter(DigitString, IntOps)
                end
            end;
          EnterCh(']', IntOps)
        end
    end { enterintops };

  begin { buildbanner }
    with PageLayout do
      begin
        Title := Heading;
        SubTitle := SubHeading;
        EnterBoolOps;
        EnterIntOps;
        date(Today);
        time(Now);
        PageNum := 1;
        LinesLeft := LinesPerPage
      end
  end { buildbanner };

procedure PrintBanner;

  begin
    { form-feed omitted for the Perq }
    with PageLayout do
      begin
        write(ListFile, Title, ' ':4);
        write(ListFile, IntOps);
        write(ListFile, ' ':4, ' on ', Today, ' at ', Now);
        writeln(ListFile);
        write(ListFile, SubTitle, ' ':4);
        write(ListFile, BoolOps);
        write(ListFile, ' ':20, 'Page ', PageNum: 3);
        writeln(ListFile);
        writeln(ListFile);
        writeln(ListFile)
      end
  end { printbanner };

procedure EjectPage;

  begin
    with PageLayout do
      begin
        PageNum := PageNum + 1;
        LinesLeft := LinesPerPage;
        Title := Heading;
        SubTitle := SubHeading;

        { instead of form-feed on the Perq }
        writeln(ListFile);
        PrintBanner
      end
  end { EjectPage };

procedure EjectLines (LinesNeeded: PageDepth);

  var i: PageDepth;

  begin
    with PageLayout do
      if LinesNeeded > LinesLeft
      then EjectPage
      else
        with Source^.Position do
          for i := 1 to LinesNeeded do
            begin
              writeln(ListFile);
              LinesLeft := LinesLeft - 1
            end
  end { EjectLines };

procedure ClaimLines(LinesNeeded: PageDepth);

  begin
    with PageLayout do
      if LinesNeeded > LinesLeft then EjectPage
  end { CheckLines };

procedure WriteLine;

  begin
    with PageLayout do
      begin
        ClaimLines(1);
        writeln(ListFile);
        LinesLeft := LinesLeft - 1
      end
  end { WriteLine };

{

 
 5.2 Error reporting
 
 During analysis of each source line,  (error-code/position)  pairs
 are  collected  on  two  lists,  one  for  errors referring to the
 current line, the other  for  those  referring  to  lines  already
 listed.  All  errors  so  collected are output to the listing when
 compilation of the line is complete, by the procedure ListErrors.
 
 Errors referring to the line just listed are reported by  using  a
 numeric  error code and marking the position in the line by an up-
 arrow marker. Errors that refer to an earlier  line  are  reported
 using  line  and  character  numbers for the symbol(s) in error. A
 'segment' of source text in error, as signalled by StartError,  is
 indicated  by  a string of markers, beginning at the first symbol,
 and continuing until the start of the next correct symbol  in  the
 input source.
 
 In this implementation, errors are  classed  as  lexical,  syntax,
 semantic,  predicted, system, fatal, option, pragmatic, or warning
 errors. All but the last of these is regarded as fatal as  far  as
 code-generation  is  concerned.  Each class of error is associated
 with an error-number range. These ranges are as follows:
 
 
       Class             Number Range
 
       Lexical            0  ..   9
       Syntax            10  .. 100
       Semantic          101 .. 300
       Predicted*        301 .. 400
       System            401 .. 420
       Fatal             421 .. 450
       Option            451 .. 470
       Pragmatic         471 .. 490
       Warning           491 .. 500
 
 
 * This range is for reserved for runtime errors predicted
   at compile-time.
 
 
 Error-code selection is performed by the procedures  WarningError,
 SystemError,  and  FatalError  in  this  module, and by procedures
 SemanticError and OptionError in modules 9 and 3 respectively.  No
 runtime errors are predicted by this version of the checker.  Lex-
 ical errors are reported from the lexical analyser in module 8 and
 syntax errors from the syntax analyser in module 9.

                                                                     }

procedure ClearErrorLists;

  begin
    with Source^ do
      begin
        ErrorsOnThisLine.First := nil;
        ErrorsOnThisLine.Last := nil;
        EarlierErrors.First := nil;
        EarlierErrors.Last := nil
      end
  end;

procedure Error (Code: ErrorSpan; Position: TextPosition);
  visible;

  procedure AddTo(var List: ErrorList);

    var NewError: ErrorEntry;

    begin
      new(NewError);
      with NewError^ do
        begin
          ErrorCode := Code;
          ErrorPosition := Position;
          Next := nil
        end;
      with List do
        begin
          if First = nil
          then First := NewError else Last^.Next := NewError;
          Last := NewError
        end
    end;

  begin { error }
    CodeIsToBeGenerated := false;
    if Position.LineNumber = Source^.Position.LineNumber
    then AddTo(Source^.ErrorsOnThisLine)
    else AddTo(Source^.EarlierErrors);
    Source^.ErrorsToReport := true
  end { error };

procedure PragmaticError(Code: Scalar);
  visible;

  begin
    Error(Code + PragmaticBase, StartOfSymbol)
  end;

procedure SystemError (Code: Scalar);
  visible;

  begin Error(Code + SystemBase, StartOfSymbol) end;

procedure FatalError (Code: Scalar);
  visible;

  begin
    Error(Code + FatalBase, StartOfSymbol);
    Abort
  end;

procedure StartError (Position: TextPosition);
  visible;

  begin Error(StartCode, Position) end;

procedure ListErrors;

  var
    ThisError, NextError: ErrorEntry;
    NextPrintPosition: Scalar;
    LastArrowPosition, LastCharPosition: 0..LineMax;
    LastWasCode: Boolean;

  procedure StartErrorLine;

    begin
      WriteLine;
      write(ListFile, ' *****  ');
      LastWasCode := false;
      NextPrintPosition := 1
    end { starterrorline };

  procedure PrintArrowAt(Position: LinePosition);

    begin
      if Position < NextPrintPosition then StartErrorLine;
      write(ListFile, '^': Position - NextPrintPosition + 1);
      LastWasCode := false;
      LastArrowPosition := Position;
      NextPrintPosition := Position + 1
    end { printarrowat };

  procedure PrintCode(Code: integer);

    var Width: 1..3;

    begin
      if Code < 10
      then Width := 1
      else
        if Code < 100 then Width := 2 else Width := 3;
      write(ListFile, Code: Width);
      LastWasCode := true;
      NextPrintPosition := NextPrintPosition + Width;
      Reported[Code] := true;
      ErrorCount := ErrorCount + 1
    end { printcode };

  procedure PrintComma;

    begin
      write(ListFile, ',');
      LastWasCode := false;
      NextPrintPosition := NextPrintPosition + 1
    end { printcomma };

  begin { listerrors }
    with Source^ do
      begin
        WriteLine;

        { report errors detected on the }
        { current line                  }

        StartErrorLine;
        LastArrowPosition := FirstNonBlank - SourceFile.StartOfLine;
        ThisError := ErrorsOnThisLine.First;
        while ThisError <> nil do
          begin
            with ThisError^ do
              begin
                if ErrorStarted
                then
                  while NextPrintPosition < ErrorPosition.CharNumber do
                    PrintArrowAt(NextPrintPosition);
                if ErrorCode = StartCode
                then
                  begin
                    if ErrorPosition.CharNumber <> LastArrowPosition
                    then PrintArrowAt(ErrorPosition.CharNumber);
                    ErrorStarted := true
                  end
                else
                  begin
                    if ErrorPosition.CharNumber = LastArrowPosition
                    then
                      begin
                        if LastWasCode then PrintComma
                      end
                    else PrintArrowAt(ErrorPosition.CharNumber);
                    PrintCode(ErrorCode);
                    ErrorStarted := false
                  end
              end;
            NextError := ThisError^.Next;
            dispose(ThisError);
            ThisError := NextError
          end;
        if ErrorStarted
        then
          begin
            LastCharPosition := LastSignificant -
                                SourceFile.StartOfLine + 1;
            while LastArrowPosition < LastCharPosition do
              PrintArrowAt(NextPrintPosition)
          end;

        { report errors detected retrospectively and }
        { occurring on an earlier line               }

        ThisError := EarlierErrors.First;
        while ThisError <> nil do
          begin
            with ThisError^ do
              begin
                StartErrorLine;
                write(ListFile, 'Error ');
                PrintCode(ErrorCode);
                with ErrorPosition do
                  write
                    (ListFile, ' at character', CharNumber: 3,
                     ' of line', LineNumber: 6)
              end;
            NextError := ThisError^.Next;
            dispose(ThisError);
            ThisError := NextError
          end;
        WriteLine;
        ErrorsToReport := ErrorStarted;
        ClearErrorLists
      end
  end { listerrors };

{

 5.3.1 Source line input and listing
 
 Source input and listing are driven by  the  succession  of  calls
 from the analyser to the procedure Nextch. For most Pascal proces-
 sors the efficiency of this source character handling has a  major
 impact on overall speed. Accordingly, this implementation exploits
 low-level UNIX i/o facilities to provide  input  on  a  disk-block
 rather  than  a  text-line  basis. Pointers are then positioned to
 mark line boundaries and the first non-blank line character within
 an  approproately  sized  disk-block  buffer. Within the limits of
 efficiency imposed by  the  host  Pascal  compiler,  this  enables
 source  text  to  be analysed at rates in excess of 2000 lines per
 minute.
 
 Listing of the current source line and input of  the  next  source
 line  is triggered when the procedure Nextch has read the signifi-
 cant portion of the  current  line.   The  procedure  ListThisLine
 lists  the current line, with a preceding line number, if the list
 option has been requested.  Otherwise the line is listed  only  if
 there are errors to report.

                                                                     }

procedure ListThisLine;

  var i: BufferPosition;

  begin { listthisline }
    with Source^ do
      if (Listing in LocallyRequested) or ErrorsToReport
      then
        begin
          if ErrorsToReport
          then ClaimLines(3) else ClaimLines(1);
          write(ListFile, Position.LineNumber: 6);
          if not BlankLine
          then
            begin
              write(ListFile, '  ': 2 + FirstNonBlank - FirstRead);
              for i := FirstNonBlank to LastNonBlank do
                write(ListFile, SourceFile.Buffer[i])
            end;
          if ErrorsToReport then ListErrors;
          WriteLine
        end
  end { listthisline };

{

 5.3.2 Optimised multi-source input
 
 The procedure ReadNextLine calls the low-level support  module  to
 delineate the next line in the file-buffer and sets markers to the
 first and last significant characters. These markers enable  lead-
 ing  and  trailing  blanks,  and  completely  blank  lines,  to be
 screened from Nextch and the analyser that calls it.
 
 In order to handle multi-source input, a stack of SourceRecords is
 kept,  whose  top-most  entry is referenced by the global variable
 Source. The procedures OpenSource and CloseSource are  responsible
 for pushing and popping entries on this stack. Each entry contains
 a descriptor record for the associated UNIX file, pointers to  the
 appropriate  file  buffer, and a local LineNumber/CharNumber pair.
 In addition, the current set of LocallyRequested options is stored
 prior  to  opening  secondary input, and restored on return to the
 orginal source-file.
 
 To protect against circular import chains, a linear list of import
 records  is  maintained.  Each  new  file nominated as a secondary
 input source is checked against the entries on the import list  by
 the procedure SearchImports. If none is found, the name is entered
 on the list by procedure RecordImport and the file is  opened.  If
 an  entry  already  exists  on  the list however, the directive is
 ignored.

                                                                     }

procedure FirstChOfNextLine;
  forward;

procedure OpenSource(Name: ArgString);

  var EntryFound: ImportEntry;

  procedure SearchImports(var Entry: ImportEntry);

    var Found: Boolean;

    begin
      Entry := ImportList; Found := false;
      while (Entry <> nil) and (not Found) do
        with Entry^ do
          if Name = FileName
          then Found := false
          else Entry := Next
    end  { SearchImports };

  procedure RecordImport;

    var NewEntry: ImportEntry;

    begin
      new(NewEntry);
      with NewEntry^ do
        begin
          FileName := Name;
          Next := ImportList
        end;
      ImportList := NewEntry
    end { RecordImport };

  procedure StartNewSource;

    var NewSource: SourceEntry;

    begin
      new(NewSource);
      with NewSource^ do
        begin
          ResetFile(SourceFile, Name);
          Position.LineNumber := 1;
          ErrorStarted := false;
          ErrorsToReport := false;
          FirstLine := true;
          Control := [];
          Next := Source
        end;
      Source := NewSource
    end { StartNewSource };

  begin
    SearchImports(EntryFound);
    if EntryFound = nil
    then
      begin
        if Source <> nil
        then Source^.Control := LocallyRequested;
        StartNewSource;
        RecordImport;
        ClearErrorLists
      end
  end { OpenSource };

procedure CloseSource;

  var ThisSource: SourceEntry;

  begin
    if Source^.Next = nil
    then
      begin
        StartOfSymbol.LineNumber := Source^.Position.LineNumber;
        FatalError(3)
      end
    else
      begin
        if Listing in LocallyRequested
        then
          begin
            EjectLines(1);
            writeln(ListFile, ' -----');
            EjectLines(1)
          end;
        CloseFile(Source^.SourceFile);
        ThisSource := Source;
        Source := ThisSource^.Next;
        dispose(ThisSource);
        LocallyRequested := Source^.Control
      end
  end { CloseSource };

{

 5.3.3 Embedded Directive Processing
 
 Directives controlling settings of locally selectable options  may
 be embedded in the source-program. To aid recognition, such direc-
 tives must be prefixed by a three-character directive  string.  By
 default,  this  string is '***', but it may be varied using the -d
 control option.  To minimise the overhead of  directive  scanning,
 procedure  CheckDirective  will  consider  the  line  only  if the
 checker has been invoked with the  DIRECTIVES+  option,  and  even
 then,  only  if  the  first non-blank character marker matches the
 start of line marker.
 
 Directive recognition proceeds  by  extracting  the  leading  sub-
 string whose characters belong to a set defined by the contents of
 global variable DirChars. This set is initialised by  the  Option-
 Handler  and  contains  the upper-case letters plus the characters
 comprising the directive flag. Following extraction, the substring
 is  compared  against  the elements of a linear array of directive
 names stored in global variable DirNames. Directives that are  not
 recognised by this process are flagged and ignored by the checker.
 
 The arguments of valid directives are read  and  checked  by  pro-
 cedure  ReadArgument and the directive is interpreted by procedure
 ObeyDirective. The set of implemented directives is as follows.
 
 
       Directive          Function
 
       READ               Read secondary source file
       PAGE               Eject a new listing page
       LINES              Eject blank listing lines
       HEADING            Display new listing sub-heading
       LIST               Change listing control options
 
 

                                                                     }

procedure ReadNextLine;

  var Directive: ICLDirectives;
      DirCh: char;
      DirIndex: BufferPosition;

  procedure ReadSourceLine;

    var LineRead: Boolean;

    procedure ReadLine;

      begin
        with Source^ do
          begin
            BlankLine := true;
            ReadFileLine(SourceFile);
            if not EndOfFile(SourceFile)
            then
              with SourceFile do
                begin
                  FirstRead := StartOfLine;
                  BufferIndex := StartOfLine;
                  while Buffer[BufferIndex] <> chr(NewLine) do
                    begin
                     if Buffer[BufferIndex] <> ' '
                     then
                       begin
                         if BlankLine
                         then
                           begin
                             FirstNonBlank := BufferIndex;
                             BlankLine := false
                           end;
                         LastNonBlank := BufferIndex
                       end;
                     BufferIndex := BufferIndex + 1
                   end;
                 EndOfLine := BufferIndex
               end;
             FirstLine := false
           end
      end { readline };

    begin
      LineRead := false;
      repeat
        ReadLine;
        if EndOfFile(Source^.SourceFile)
        then CloseSource
        else LineRead := true
      until LineRead
    end { ReadSourceLine };

  procedure NextDirCh;

    begin
      with Source^, SourceFile, Position do
        begin
          if DirIndex < EndOfLine
          then
            begin
              DirIndex := DirIndex + 1;
              CharNumber := CharNumber + 1;
              DirCh := Buffer[DirIndex]
            end
        end
    end { NextDirCh };

{

 5.3.4 Character Streaming
 
 The procedures FirstChOfNextLine and NextCh  are  responsible  for
 delivering a character stream to the lexical analyser. To minimise
 the number of calls to NextCh, blank lines and leading blank char-
 acters  are screened out by procedure FirstChOfNextLine. Tab char-
 acters  are  regarded  as  significant  however,  since  they  are
 required  on  output to reconstruct an identical source line-image
 on the listing file.
 
 The   field  BufferIndex  of  the  current  SourceFile  descriptor
 selects  the  next character from the file buffer. The field Char-
 Number of the current  SourceFile  Position  record  maintains  an
 equivalent  relative  measure  of  the displacement of BufferIndex
 from the start of the current line.

                                                                     }

  procedure NextNonBlank;

    begin
      while DirCh = ' ' do NextDirCh
    end { NextNonBlank };

  procedure CheckDirective;

    var Index: 0..OptionSize;
        ThisName: DirectiveString;

    begin
      with Source^, SourceFile do
        if FirstNonBlank = StartOfLine
        then
          begin
            ThisName := '            ';
            DirIndex := StartOfLine;
            Position.CharNumber := 1;
            DirCh := Buffer[DirIndex];
            Index := 0;
            while (Index < OptionSize) and (DirCh in DirChars) do
              begin
                Index := Index + 1;
                ThisName[Index] := DirCh;
                repeat NextDirCh until DirCh <> ' ';
              end;
            DirName[DoNothing] := ThisName;
            Directive := DoInclude;
            while DirName[Directive] <> ThisName do
              Directive := succ(Directive)
          end
        else Directive := DoNothing
    end { CheckDirective };

  procedure ObeyDirective;

    type ArgKind = (Literal, Numeric, Invalid, None);

    var Argument: record
                    case Kind: ArgKind of
                      None: ( );
                      Invalid: (Code: Scalar);
                      Numeric: (Value: Scalar);
                      Literal: (String: ArgString)
                  end;
        ListControl: (Short, Normal, Full);

    procedure ReadArgument;

      procedure ArgumentError(Error: Scalar);

        begin
          with Argument do
            if Kind <> Invalid
            then
              begin
                Kind := Invalid;
                Code := Error
              end
        end { ArgumentError };

      procedure ReadString(var String: ArgString);

        var Length: Scalar;

        begin
          NextNonBlank; Length := 0;
          while not (DirCh in [')', '"', chr(NewLine)]) do
            begin
              Length := Length + 1;
              if Length < MaxArgString then String[Length] := DirCh;
              NextDirCh
            end;
          for Length := Length + 1 to MaxArgString do
            String[Length] := ' '
        end { ReadString };

      procedure ReadValue(var Value: Scalar);

        begin
          Value := 0;
          while DirCh in ['0'..'9'] do
            begin
              Value := 10 * Value  + ord(DirCh) - ord('0');
              NextDirCh
            end
         end { ReadValue };

      begin
        with Argument do
          begin
            NextNonBlank;
            StartOfSymbol := Source^.Position;
            if (DirCh = '(') or (DirCh = '"')
            then
              begin
                NextDirCh;
                StartOfSymbol := Source^.Position;
                case Directive of
                  DoInclude, DoRead :
                    begin
                      Kind := Literal; ReadString(String) ;
                      Terminate(String);
                      if not Accessible(String, ForReading)
                      then FatalError(1)
                    end;
                  DoList :
                    begin
                      Kind := Literal; ReadString(String);
                      if HeadsMatch(String, 'LIST') or
                         HeadsMatch(String, 'NORMAL')
                      then ListControl := Normal
                      else
                        if HeadsMatch(String, 'SHORTLIST') or
                           HeadsMatch(String, 'SHORT')
                        then ListControl := Short
                        else
                          if HeadsMatch(String, 'FULL')
                          then ListControl := Full
                          else ArgumentError(4)
                    end;
                  DoHeading :
                    begin
                      Kind := Literal; ReadString(String)
                    end;
                  DoLines :
                    if not (DirCh in ['0'..'9'])
                    then ArgumentError(5)
                    else
                      begin
                        Kind := Numeric; ReadValue(Value);
                        if Value > LinesPerPage then ArgumentError(6)
                      end
                end;
                StartOfSymbol := Source^.Position;
                if (DirCh <> ')') and (DirCh <> '"')
                then ArgumentError(7)
              end
            else ArgumentError(3)
          end
      end { ReadArgument };

    procedure ListDirective;

      begin
        with Source^.Position do
          begin
            ListThisLine;
            LineNumber := LineNumber + 1
          end
      end { ListDirective };

    begin
      Argument.Kind := None;
      if Directive <> DoPage then ReadArgument;
      with Argument do
        if Kind <> Invalid
        then
          begin
            case Directive of
              DoInclude, DoRead :
                begin
                  if Listing in LocallyRequested then EjectLines(1);
                  ListDirective;
                  if Listing in LocallyRequested then EjectLines(1);
                  OpenSource(String);
                  if not (Imports in LocallyRequested)
                  then SetLocalOptions([])
                end;
              DoPage :
                begin
                  ListDirective;
                  if Listing in LocallyRequested then EjectPage
                end;
              DoLines :
                begin
                  ListDirective;
                  if Listing in LocallyRequested then EjectLines(Value)
                end;
              DoHeading :
                begin
                  ListDirective;
                  ResetTitle(SubHeading, String)
                end;
              DoList :
                case ListControl of
                  Short :
                    begin
                      ListDirective;
                      SetLocalOptions([])
                    end;
                  Normal :
                    begin
                      SetLocalOptions([Listing]);
                      ListDirective
                    end;
                  Full :
                    begin
                      SetLocalOptions([Listing, Imports]);
                      ListDirective
                    end
                end
            end
          end
        else
          begin
            PragmaticError(Code);
            ListDirective
         end
    end { ObeyDirective };

  begin { ReadNextLine }
    Directive := DoNothing;
    repeat
      ReadSourceLine;
      if Directives in Requested then CheckDirective;
      if Directive <> DoNothing then ObeyDirective
    until Directive = DoNothing
  end { ReadNextLine };

{

 5.4 Source initialisation and finalisation
 
 Before  analysis  begins  the  procedure  InitListing  outputs  an
 appropriate  header  to  the  listing file, initialises the source
 description variables, and inputs the first source  line  to  make
 its first character available.
 
 When analysis is complete the procedure EndListing lists the final
 line,  if  necessary. If errors have been reported during compila-
 tion it then retrieves and lists an explanatory message  for  each
 numeric  error  code  actually used, from the text file ErrorFile.
 Finally the procedure prints a listing trailer showing the  number
 of source lines compiled and number of errors reported.

                                                                     }

procedure FirstChOfNextLine;

  begin
    ReadNextLine;
    while Source^.BlankLine do
      begin
        ListThisLine;
        with Source^.Position do
          LineNumber := LineNumber + 1;
        ReadNextLine
      end;
    with Source^, Position, SourceFile do
      begin
        LastSignificant := LastNonBlank;
        CharNumber := FirstNonBlank - StartOfLine + 1;
        BufferIndex := FirstNonBlank;
        Ch := Buffer[BufferIndex]
      end
  end { firstchofnextline };

procedure NextCh;
  visible;

  begin
    with Source^, Position, SourceFile do
      if BufferIndex >= LastSignificant
      then
        if BufferIndex = LastSignificant
        then
          begin
            CharNumber := CharNumber + 1;
            BufferIndex := BufferIndex + 1;
            Ch := ' '
          end
        else
          begin
            ListThisLine;
            LineNumber := LineNumber + 1;
            FirstChOfNextLine
          end
      else
        begin
          CharNumber := CharNumber + 1;
          BufferIndex := BufferIndex + 1;
          Ch := Buffer[BufferIndex]
        end
  end { nextch };

function LineEnded: Boolean;
  visible;

  begin
    with Source^, Position, SourceFile do
      LineEnded := (BufferIndex > LastSignificant)
  end { lineended };

 

procedure InitListing;
  visible;

  var Code: ErrorSpan;

  begin
    Terminate(Arg2);
    rewrite(ListFile, Arg2);
    Heading := ProgName;
    Heading[VerNumPos] := chr(VerNum + ord('0'));
    Heading[RelNumPos] := chr(RelNum + ord('0'));
    ResetTitle(SubHeading, Arg6);
    BuildBanner(Requested);
    if Listing in LocallyRequested then PrintBanner;
    ErrorCount := 0;
    for Code := 1 to MaxCode do Reported[Code] := false;
    Source := nil;
    ImportList := nil;
    OpenSource(Arg1);
    FirstChOfNextLine
  end { initlisting };

procedure PrintErrorTexts;

  var Code, LastCode: ErrorSpan;

  procedure FindText;

    var i: integer;

    begin
      for i := 1 to (Code - LastCode - 1) * LinesPerText do
        readln(ErrorFile);
      LastCode := Code
    end { findtext };

  procedure PrintText;

    var
      Ch: char;
      i: 1..LinesPerText;

    begin
      for i := 1 to LinesPerText do
        begin
          if not eoln(ErrorFile)
          then
            begin
              repeat
                Ch := ErrorFile^;
                get(ErrorFile);
                write(ListFile, Ch)
              until eoln(ErrorFile);
              writeln(ListFile)
            end;
          readln(ErrorFile)
        end
    end { printtext };

  begin { printerrortexts }
    LastCode := 0;
    for Code := 1 to MaxCode do
      if Reported[Code]
      then
        begin
          FindText;
          PrintText
        end
  end { printerrortexts };

procedure EndListing;
  visible;

  begin
    ListThisLine;
    CloseFile(Source^.SourceFile);
    if Listing in LocallyRequested
    then
      begin
        writeln(ListFile);
        writeln(ListFile)
      end;
    if ErrorCount > 0
    then
      begin
        Terminate(Arg4);
        reset(ErrorFile, Arg4);
        if eof(ErrorFile)
        then writeln(ListFile, ' Error summary not available.')
        else PrintErrorTexts;
        close(ErrorFile);
        writeln(ListFile);
        writeln(ListFile)
      end;
    write(ListFile, 'Analysis complete : ');
    if ErrorCount = 0
    then write(ListFile, '     no') else write(ListFile, ErrorCount: 7);
    writeln(ListFile, ' errors reported');
    writeln
      (ListFile, 'Source program    : ', Source^.Position.LineNumber: 7,
       ' lines');
    close(ListFile)
  end { endlisting };

begin
  { end of module }
end.